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Summary  Page 


THE  PROBLEM 

To  provide  a  programmer’s  manual  for  the  Dental  Emergencies  Diagnostic  System 
(DENTAL). 

THE  FINDINGS 

The  manual  lists  and  describes  all  programs,  data,  and  text  files. 

APPLICATION 

The  information  presented  in  this  manual  will  allow  programmers  to  understand  and 
modify  DENTAL  as  necessary  to  enhance  its  capabilities  or  to  correct  program  malfunc¬ 
tions. 


ADMINISTRATIVE  INFORMATION 

This  work  was  conducted  under  Naval  Medical  Research  and  Development  Command 
Research  Work  Unit  MM33C30.002-5004.  It  was  submitted  for  review  on  19  June  1989, 
approved  for  publication  on  02  February  1990,  and  has  been  designated  as  Naval  Sub¬ 
marine  Medical  Research  Laboratory  Report  No.  1 156. 


Abstract 


DENTAL  is  a  medical  decision  support  system  for  the  diagnosis  and  management  of  dental 
emergencies.  The  user’s  manual  has  already  been  published  as  NSMRL  Report  #  1 143.  This 
report  is  written  to  function  as  the  programmer’s  manual  for  DENTAL.  The  report  lists  and 
describes  the  purpose  of  all  programs,  data,  and  text  files. 

Familiarity  with  Microsoft  QuickBASIC  is  required  to  modify  DENTAL  or  to  use  this  manual  ef¬ 
fectively  to  identify  program  malfunctions. 
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1.  Introduction  to  the  DENT AL  Programmer’s  Manual 

DENTAL  is  the  Dental  Emergencies  Diagnostic  Module  developed  for  the  diagnosis  and 
medical  management  of  dental  emergencies  by  Independent  Duty  Corpsmen  aboard  sub¬ 
marines. 

The  DENTAL  User’s  Manual  (NSMRL  Report  #1 143)  contains  information  that  is  impor¬ 
tant  to  the  user  on  how  to  run  the  program.  The  user’s  manual  does  not  contain  program¬ 
ming  information.  The  DENTAL  Programmer’s  Manual  contains  programming 
documentation  for  the  Dental  Emergencies  Diagnostic  Module. 

1.1  Purpose  of  the  Programmer’s  Manual 

The  purpose  of  this  manual  is  to  document  the  actual  program  listings  to  aid  any  future 
modifications  to  DENTAL.  This  report  is  a  programmer’s  manual.  It  contains  a  brief 
description  of  each  program  and  its  listing.  This  manual  should  be  used  by  a  program¬ 
mer  familiar  with  Microsoft  BASICA  or  QuickBASIC1.  The  manual  will  not  be  useful 
to  other  readers. 

Information  on  use  of  the  current  program  may  be  found  in  the  Dental  user’s  manual, 
NSMRL  Report  #1 143. 

1.2  Background  of  DENTAL 

The  Dental  Diagnostic  Module  was  originally  written  in  Basic  on  the  Apple  computer. 
As  IBM  personal  computers  (PC)  were  installed  on  submarines,  the  program  was  made 
MS-DOS  compatible  and  rewritten  in  BASICA. 

Microsoft  QuickBASIC  has  superseded  BASICA,  so  the  latest  version  of  DENTAL  has 
been  written  in  Microsoft  QuickBASIC  3.0.  DENTAL  fits  on  a  single  360  kilobyte 
floppy  disk.  The  program  runs  on  a  machine  with  512  kilybytes  of  RAM,  though  less 
memory  may  be  required. 

2.  Description  of  the  program  files. 

There  are  two  programs  that  are  distributed  with  the  DENTAL  system.  They  are  DEN- 
TAL.EXE  and  DIFF.EXE. 


1  Microsoft  and  MS-DOS  are  registered  trademarks  of  Microsoft  corporation.  IBM  is  a 

registered  trademark  of  International  Rusiness  Machines  Corporation.  Apple  is  a  registered 
trademark  of  Apple  Computers  Inc. 
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2.1  DENTAL.EXE 


This  is  the  main  Dental  Diagnostic  program.  This  is  the  only  program  that  the  user  ex¬ 
ecutes. 

2.2  DIFF.EXE 

This  is  the  Differential  Diagnosis  program.  It  is  executed  from  the  main  program  (DEN¬ 
TAL.EXE). 

3.  Description  of  the  program  utility  files. 

The  following  programs  are  not  included  in  the  distributed  DENTAL  system,  but  are  useful 
to  the  programmer. 

3.1  DEFBLD.BAS 

This  program  creates  the  term  definition  file  (DEF.RND)  and  the  term  definition  index 
(DEF.IDX)  from  data  statements  within  the  program. 

3.2  DISDFBLD.BAS 

This  program  creates  the  disease  definition  file  (DISDEF.RND)  and  the  disease  defini¬ 
tion  index  (DISDEF.IDX)  from  the  file  DXDEF.TXT. 

3.3  TREATBLD.BAS 

This  program  creates  the  random  access  treatment  plan  file  (TRTMTS.RND)  from  the 
ASCII  file  TRTMTS.TXT. 

4.  Description  of  definition  files. 

The  following  files  are  the  random  access  files  and  indexes  used  by  the  definition  routines. 

4.1  DEF.RND 

This  file  contains  the  term  definitions.  It  is  a  random  access  file  with  60  characters  per 
record. 

4.2  DEF.IDX 

This  is  a  sequential  ASCII  file  that  contains  the  index  for  the  term  definitions  which  the 
dental  program  loads  into  the  arrays  dindx  and  item$.  The  format  is: 

dindx(x,l)  -  The  record  number  for  the  beginning  of  this  definition. 
dindx(x,2)  -  The  number  of  records  for  this  definition. 
item$(x)  -  The  term  to  be  defined. 

4.3  DISDEF.RND 

This  file  contains  the  disease  definitions.  It  is  a  random  access  file  with  58  characters 
per  record. 
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4.4  DISDEF.EDX 


This  is  a  sequential  ASCII  file  that  contains  the  index  for  the  disease  definitions  which 
the  dental  program  loads  into  the  arrays  disindx  and  disease$.  The  format  is: 

disindx(x,l)  -  The  record  number  for  the  beginning  of  this  definition. 
disindx(x,2)  -  The  number  of  records  for  this  definition. 
disease$(x)  -  The  disease  to  be  defined. 

5.  Description  of  the  data  file  DENT  AL.D  AT 

DENTAL.DAT  contains  the  information  the  user  entered  and  the  computer’s  diagnosis  for 
each  case.  Every  time  a  case  is  stored,  the  information  is  appended  to  the  end  of  this  file.  If 
the  file  does  not  exist,  it  is  created. 

This  data  file  is  a  random  access  file  with  a  record  length  of  474  bytes.  Each  record  contains 
1 1  variables.  Each  variable  is  listed  below  along  with  a  brief  description,  its  length,  and  its 
starting  position  in  the  record. 

Starting 

Variable _ Position _ Length _ Description _ 


ss$ 

1 

9 

The  patient’s  social  security  number. 

ag$ 

10 

2 

The  patient’s  age. 

dt$ 

12 

10 

The  date  converted  into  a  string. 

tm$ 

22 

5 

The  time  converted  into  a  string. 

r$ 

27 

92 

The  92  responses  from  DENTAL  and  DIFF  converted 
into  a  string. 

npb$ 

119 

2 

The  total  number  of  probable  diagnoses. 

nps$ 

121 

2 

The  total  number  of  possible  diagnoses. 

pb$ 

123 

70 

The  identifying  numbers  for  the  probable  diagnoses 
converted  into  a  string. 

ps$ 

193 

70 

The  identifying  numbers  for  the  possible  diagnoses 
converted  into  a  string. 

cpdx$ 

263 

72 

The  corpsman’s  diagnosis  converted  into  a  string. 

othr$ 

335 

40 

The  corpsman’s  response,  if  he  chose  "Other". 

6.  Description  of  the  T reatment  Plan  files. 

The  following  files  contain  the  treatment  plans  in  different  formats. 


6.1  TRTMTS.RND 

This  file  is  a  random  access  file  that  contains  the  treatment  plans.  The  length  of  each 
record  is  75  bytes.  Each  treatment  plan  is  terminated  by  a  "I"  (ASCII  124). 

6.2  TRTMTS.TXT 

This  file  is  the  ASCII  version  of  the  treatment  plan  file. 
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7.  Description  of  batch  flies. 


The  following  batch  files  are  not  necessary,  but  they  make  compiling,  Unking,  and  copying 
the  DENTAL  system  more  convenient. 

7.1  DENTLIB.BAT 

This  is  a  batch  file  that  creates  the  user  library.  It  is  shown  below. 
buildlib  defrtns.obj  dentsubs.obj  winsave.obj  fprint.obj  int86.obj; 

7.2  DENTBLD.BAT 

This  is  a  batch  file  that  compiles  and  links  the  Dental  and  Diff  programs.  It  is  shown 
below. 

qb  dentalll; 
qb  diff/l; 
link  dental; 
link  diff; 

7.3  COPYDEN.BAT 

This  is  a  batch  file  that  copies  the  files  necessary  to  copy  the  system  to  a  floppy  disk.  It 
is  shown  below. 

COPY/V  \DENTAL\STEVE2\DENTALQ3\USERLIB.EXE  A:*.* 

COPY/V  \DENTAL\STEVE2\DENTALQ3\DENTAL.EXE  A:*.* 

COPY/V  \DENTAL\STEVE2\DENTALQ3\DIFF.EXE  A:*.* 

COPY/V  \DENTAL\STEVE2\DENTALQ3\TRTMTS.RND  A:*.* 

COPY/V  \DENTAL\STEVE2\DENTALQ3\DEF.IDX  A:*.* 

COPY/V  \DENTAL\STEVE2\DENTALQ3\DEF.RND  A:*.* 

COPY/V  NDENT ALNSTE VE2SDENT ALQ3NDIS DEF. IDX  A:*.* 

COPY/V  \DENTAL\STEVE2\DENTALQ3\DISDEF.RND  A:*.* 

COPY/V  NQUICK3\BRUN30.EXE  A:*.* 

8.  DescriptionofBRUN30.EXE. 

BRUN30.EXE  is  the  Microsoft  QuickBASIC  run-time  module.  It  must  be  present  in  order 
to  run  the  DENTAL  and  DIFF  programs. 
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9.  Description  of  BRUN30.LIB. 


This  is  the  Microsoft  QuickBASIC  run-time  module  library.  It  must  be  present  in  order  to 
link  the  Dental  and  Diff  programs. 

10.  Description  of  USERLIB.EXE. 

USERLIB.EXE  is  a  library  of  subroutines  that  the  Dental  and  Diff  programs  use.  The 
modules  that  are  combined  to  create  the  user  library  are: 

10.1  DEFRTNS.BAS 

This  module  contains  the  definition  and  window  routines. 

10.2  DENTSUBS.BAS 

This  module  contains  the  subroutines  for  DENTAL  and  DIFF. 

10.3  WINSAVE.ASM 

This  is  the  assembly  language  routine  to  save  the  text  behind  a  window. 

10.4  FPRINT.ASM 

This  is  the  assembly  language  routine  to  print  text  fast. 

10.5  INT86.0BJ 

This  is  a  QuickBASIC  supplied  assembly-language  subroutine  that  provides  software  in¬ 
terrupt  support  for  system  service  calls. 

11.  Procedure  to  compile  and  link. 

DENTAL.BAS,  DIFF.BAS,  DEFRTNS.BAS  and  DENTSUBS.BAS  are  compiled  using  the 
QuickBASIC  3.0  compiler.  Use  the  /L  option  for  DENTAL.BAS  and  DIFF.BAS  (it  allows 
them  to  access  the  user  library).  The  assembly  language  subroutines  WINSAVE.ASM  and 
FPRINT.ASM  are  compiled  using  the  microsoft  MACRO  assembler  Version  1.27, 
MASM.EXE,  but  should  also  compile  with  any  later  version  without  difficulty.  LINK.EXE, 
the  Microsoft  linker,  is  used  to  link  the  object  modules  DENTAL.OBJ  and  DIFF.OBJ.  The 
library  file,  BRUN30.LIB  must  be  present  on  the  disk  in  order  to  link  the  DENTAL  and 
DIFF  object  modules. 

The  batch  file  DENTBLD.BAT,  is  used  to  compile  and  link  the  DENTAL  and  DIFF 
programs. 

NOTE:  If  any  of  the  programs  that  are  combined  to  create  the  user  library  are  modified,  it 
must  be  rebuilt  and  the  DENT. AL  and  DIFF  programs  must  be  recompiled. 
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12.  Procedure  to  change  the  Term  Definition  files. 

Load  the  program  DEFBLD.BAS  into  the  QuickBASIC  environment.  Edit  the  definitions  in 
the  data  statements  located  at  the  bottom  of  the  program.  Press  CTRL-R  to  run  the  program 
and  create  new  DEF.RND  and  DEF.IDX  files. 

13.  Procedure  to  change  the  Disease  Definition  files. 

Edit  the  ASCII  file  of  disease  definitions  (DXDEF.TXT).  Load  the  program  DIS- 
DFBLD.BAS  into  the  QuickBASIC  environment  and  press  CTRL-R  to  run  it. ..  will  create 
new  DISDEF.RND  and  DISDEF.IDX  files. 

14.  Procedure  to  change  the  treatment  files 

Edit  the  ASCII  file  TRTMTS.TXT.  Load  the  program  TREATBLD.BAS  into  the 
QuickBASIC  environment  and  press  CTRL-R  to  run  it.  It  will  create  a  new  TRTMTS.RND 
file.  Check  the  record  numbers  that  appear  on  the  screen  against  the  data  statements  in  the 
dental  program.  If  any  of  the  record  numbers  have  changed,  the  data  statement  must  also  be 
changed  and  the  DENTAL  program  recompiled. 

15.  Procedure  to  build  the  user  library. 

After  any  modifications  are  made  to  DEFRTNS.BAS,  DENTSUBS.BAS,  WINSAVE.ASM 
and  FPRINT.ASM  recompile  them,  then  execute  DENTLIB.BAT  to  rebuild  the  user  library. 
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ANSI 

ANSI 

ATTRIB 

BEGC 

BEGR 

C 

Cl 

CORPRESP(36) 

D1 

D2 

D3 

DGLIMT 

DGPOS(35,2) 

DINDX(120,2) 

DISEASE$(34) 

DISINDX(34,2) 

DU 

DX$(35) 

El 


Appendix  A 

List  of  Variables  Used  in  Programs 

The  response  to  a  question  passed  from  getresp. 

The  response  to  a  question  passed  from  trtresp  to  seetrtmts. 

The  screen  attribute  used  by  SCROLLUP. 

Used  by  BOX,  the  column  where  the  box  begins. 

Used  by  BOX,  the  row  where  the  box  begins. 

Corresponds  with  RESPONSE(57) . 

Corresponds  with  RESPONSE(IO) . 

When  the  corpsman  is  asked  to  diagnose  the  patient,  the  cells  in 
CORPRESP  that  correspond  with  the  diseases  he  picks  are  set  to 
1. 

Corresponds  with  RESPONSE(3 ) . 

Corresponds  with  RESPONSES ) . 

Corresponds  with  RESPONSE(5 ) . 

The  maximum  number  of  characters  to  print  on  a  line. 

Line  numbers  to  keep  track  of  the  line  the  diagnosis  is  displayed 
on  are  stored  in  this  array. 

This  is  the  index  for  the  Term  Definitions. 

The  diseases  used  by  the  disease  definition  routines  are  stored  in 
this  array. 

This  is  the  index  for  the  Disease  Definitions. 

Corresponds  with  RESPONSE(7). 

This  array  contains  the  35  diseases. 

Corresponds  with  RESPONSE(  14). 
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E2 

Corresponds  with  RESPONSE(  15). 

E3 

Corresponds  with  RESPONSE!  17). 

E4 

Corresponds  with  RESPONSE!  18). 

E5 

Corresponds  with  RESPONSE ( 19). 

E6 

Corresponds  with  RESP0NSE(16). 

E7 

Corresponds  with  RESPONSE(20). 

E8 

Corresponds  with  RESP0NSE(21 ). 

E9 

Corresponds  with  RESPONSE(22). 

EA 

Corresponds  with  RESPONSE(53). 

EB 

Corresponds  with  RESPONSE(23). 

EC 

Corresponds  with  RESPONSE(24). 

EE 

Corresponds  with  RESPONSE(25). 

EG 

Corresponds  with  RESPONSE(26). 

EH 

Corresponds  with  RESPONSE(28). 

El 

Corresponds  with  RESPONSE(27). 

ENDC 

Used  by  BOX,  the  column  where  the  box  ends. 

ENDR 

Used  by  BOX,  the  row  where  the  box  ends. 

FI 

Corresponds  with  RESPONSE(67). 

FIRSTDG 

The  number  of  the  first  diagnosis  to  print  on  a  page  in  seetrtmts. 

FL 

Corresponds  with  RESPONSE(77). 

HR 

Corresponds  with  RESP0NSE(8). 

ITEM$(120) 

This  array  contains  the  terms  used  by  the  term  definition  routines. 

LASTDG 

The  number  of  the  last  diagnosis  to  print  on  a  page  in  seetrtmts. 
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LONGEST 

MAIN 

MB 

MMENU 

MON$ 


MP 

MR 

MW 

MY 

NF 

NM 

NUMDG(n) 


NUMOPS 

OPLINE(IO) 


OPnON$(10,2) 

OW 

PI 

P2 

P3 

P4 

P5 


The  number  of  characters  in  the  longest  option. 

This  is  a  constant  used  to  compare  with  responses. 

Corresponds  with  RESPONSE(86). 

This  is  used  to  save  the  response  from  the  main  menu. 

MON$  is  equal  to  "c"  if  the  monitor  is  color  and  m"  if  the  monitor 
is  monochrome. 

Corresponds  with  RESPONSE(87). 

Corresponds  with  RESPONSE(85). 

Corresponds  with  RESPONSE(84). 

Corresponds  with  RESPONSE(88). 

Corresponds  with  RESPONSE(54). 

This  is  the  total  number  of  diagnoses  in  the  program. 

NUMDG(  1)  is  a  counter  for  the  total  number  of  probable  diag¬ 
noses.  NUMDG(2)  is  a  counter  for  the  total  number  of  possible 
diagnoses. 

This  is  the  number  of  options  for  a  given  question. 

The  line  numbers  for  the  first  line  of  each  option  to  a  given  ques¬ 
tion  are  stored  in  this  array. 

Array  to  store  the  options  to  a  given  question. 

Corresponds  with  RESPONSE(50). 

Corresponds  with  RESPONSE(29). 

Corresponds  with  RESPONSE(31 ). 

Corresponds  with  RESPONSE(32). 

Corresponds  with  RESPONSE(33). 

Corresponds  with  RESPONSE(34). 
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P6 

Corresponds  with  RESPONSE(36). 

P7 

Corresponds  with  RESPONSE(37). 

P8 

Corresponds  with  RESPONSE(38). 

P9 

Corresponds  with  RESPONSE(39). 

PAGE 

This  keeps  track  of  the  page  number. 

PAUSE! 

This  variable  is  a  counter  for  the  pause  between  questions. 

PB 

Corresponds  with  RESPONSE(ll). 

PC 

Corresponds  with  RESPONSE(  12). 

PCOL 

This  variable  keeps  track  of  which  side  of  the  screen  the  diagnoses 
are  listed. 

PE 

Corresponds  with  RESPONSE ( 13). 

PG 

Corresponds  with  RESPONSE(40). 

PH 

Corresponds  with  RESPONSE(42). 

PN 

Corresponds  with  RESPONSE(9). 

POSSCOL 

Column  number  to  display  possible  diagnoses. 

POSSPTR 

Column  number  to  display  pointer  for  possible  diagnoses. 

PROBCOL 

Column  number  to  display  probable  diagnoses. 

PROBPTR 

Column  number  to  display  pointer  for  probable  diagnoses. 

PV 

Corresponds  with  RESPONSE(41). 

PZ 

Corresponds  with  RESPONSE(58). 

QCOL 

Column  number  to  display  question. 

QROW 

Row  number  to  display  question. 

QUES$ 

Variable  to  store  the  question. 

REALCASE 

Flag  for  real  case  (simulated  case  =  0;  real  case  =  1). 
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RESPONSE(92) 

Array  to  store  the  all  the  responses  to  the  questions  in  DENTAL 
and  DIFF. 

SA 

Corresponds  with  RESPONSE(80). 

SB 

Corresponds  with  RESPONSE(81 ). 

SC 

Corresponds  with  RESPONSE(83). 

SCROLLINES 

The  number  of  lines  to  scroll,  used  by  SCROLLUP. 

SH 

Corresponds  with  RESPONSE(89). 

SI 

Corresponds  with  RESPONSE(90). 

SJ 

Corresponds  with  RESPONSE(91 ). 

SK 

Corresponds  with  RESPONSE(92). 

SOFTMENU 

The  response  from  the  Soft  Tissue  Lesions  Menu  is  stored  in  this 
variable. 

SW 

Corresponds  with  RESPONSE(35). 

SZ 

Corresponds  with  RESPONSE(82). 

TO 

Corresponds  with  RESPONSE(69). 

TA 

Corresponds  with  RESPONSE(55). 

TB 

Corresponds  with  RESPONSE(56). 

TC 

Corresponds  with  RESPONSE(60). 

TDLINE(35) 

This  array  is  used  in  SEETRTMTS.  It  keeps  track  of  the  line  num¬ 
bers  where  the  diseases  are  displayed. 

TG 

Corresponds  with  RESPONSE(61 ). 

TH 

Corresponds  with  RESPONSE(66). 

TI 

Corresponds  with  RESPONSE(62). 

TJ 

Corresponds  with  RESPONSE(63). 

TK 

Corresponds  with  RESPONSE(64 ). 

DENTAL  Programmer’ s  Manual  A-5 


TL 

TM 

TN 

TP 

TPTRCOL 

TR 

TREATIDX(35) 

TREATROW 

TS 

TT 

TU 

TV 

TW 

TY 

TZ 

UZ 

WHEREFROMS 

X 

XI 
X2 
X3 
X4 
X5 


Corresponds  with  RESPONSE(65). 

Corresponds  with  RESPONSE(6). 

Corresponds  with  RESPONSE(68). 

Corresponds  with  RESPONSE(70). 

Column  number  to  display  pointer  in  SEETRTMTS. 

Corresponds  with  RESPONSE(7J). 

This  is  the  index  for  the  first  record  number  of  each  treatment  plan. 
This  contains  the  row  to  print  the  treatment  information  on. 
Corresponds  with  RESPONSE(72). 

Corresponds  with  RESPONSE(73). 

Corresponds  with  RESPONSE(74). 

Corresponds  with  RESPONSE(76). 

Corresponds  with  RESPONSE(75). 

Corresponds  with  RESPONSE(78). 

Corresponds  with  RESPONSE(79). 

Corresponds  with  RESPONSE(30). 

If  WHEREFROM  $="DiJf'  then  control  is  being  transfer  ed  from 
the  DIFF  program. 

Corresponds  with  RESPONSE(2). 

Corresponds  with  RESPONSE(43). 

Corresponds  with  RESPONSE(44). 

Corresponds  with  RESPONSE(45). 

Corresponds  with  RESPONSE(46). 

Corresponds  with  RESPONSE(47). 
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X6 

Corresponds  with  RESPONSE(48). 

X7 

Corresponds  with  RESPONSE(49). 

X8 

Corresponds  with  RESP0NSE(51 ). 

X9 

Corresponds  with  RESPONSE(52). 

XX 

Corresponds  with  RESPONSE!  1 ). 

Z(35) 

Each  cell  in  this  array  corresponds  with  a  certain  diagnosis.  If 
Z(x)=l  then  this  is  a  probable  diagnosis,  ifZ(x)-2  then  this  is  a 
possible  diagnosis. 

ZY 

Corresponds  with  RESPONSE(59). 

DENTAL  Programmer' s  Manual  A-7 


Appendix  A 
Program  Listings 


DENTAL.BAS 


REM  This  is  the  main  program.  It  was  modified  last  on  4/3/89  by  Cindy 
Burgess-Russotti. 


DEFINT  A-Z 

REM  Dimension  arrays  for  DENT. AL  and  DIFF  programs. 


DIM  Z(35) 

DIM  DX$(35) 

dim  response(92) 

dim  option$(10,  2),  opline(lO) 

dim  dgpos(35,  2),  treatnum(35, 2),  numdg(2),  treatidx(35) 
dim  tdline(35),  corprcsp(36) 

REM  Dimension  arrays  for  window  routines. 


DIM  WINDscratt(5),  WINDframatt(5),  WINDheader$(5) 

DIM  WINDrow(5),  WINDcol(5),  WINDheight(5),  WINDwidth(5) 
DIM  wind%(2000,  5) 

DIM  WINDrowptr(5),  WINDcolptr(5)  '  UL  corner  of  frame 

REM  Dimension  arrays  for  definition  routines 


DIM  item$(120),  dindx(120,  2),  disease$(34),  disindx(34,  2) 

REM  Include  common  statements  for  all  modules. 

REM  NOTE:  The  "rem"  before  the  command  is  part  of  the  command. 

RF.M  Sinclude:  ’dentcomm.bas’ 

REM  Sinclude:  ’windcomm.bas’ 

REM  Initialize  variables  for  dental. 
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dglmt=30 

dot$=chr$(254) 

selectdot$=chr$(8) 

probcol=6:posscol=46:pcol=0 

probptr=3:possptr=43 

ptr$=chr$(  1 6)+chr$(  1 6) 

blanks2$="  " 

NM=35 

begr=l  :begc=l  :endr=24:endc=80:scrollines=0:attrib=0 

ans2=0:page=0:firstdg=0  '  these  get  set  in  seetrtmts 

lastdg=0:tptrcol=0  'and  diseasedefinitions 

treatrow=0  ’ set  in  printtreatments 

other$=""  ' set  in  getuserdx 

REM  If  this  is  the  first  time  through  ( mon$=  "")  ask  if  the  display  iscolor  or  monochrome. 
The  default  is  color. 


ask: 

if  (mon$"C")  and  (mon$"c")  and  (mon$"M")  and(mon$"m") 
then 

cls.’locate  23,  4:print  "Monochrome  or  Color  Display?  (M/C)  C" 

locate  23,  40,  1 
mon$=input$(l) 
if  mon$=chr$(13)  then 
mon$="c" 
end  if 
end  if 


REM  If  monitor  is  monochrome,  then  initialize  variables  for  black,  white,  and  high 
intensity  white.  Otherwise,  initialize  variables  for  color. 


if  mon$="m"  or  mon$="M”  then 

blink=16:highlight=15:normal=7:bground=0:border=0:quescolor=15 
keyline=7:keylettr=0:ptrcolor=15:respbar=7:resplettr=0 
keyline2=  1 5  :keylettr2=0:ssnbox=7 
dotcolor=7  :otherscm=7  :otherfram=- 1 1 2 

REM  definition  routine  colors 
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defkeyline=7:defkeylettr=0:def  lf=- 1 12:def  1  s=7 
def2f=-l  12:def2s=7:selectlf=-l  12:select2f=-l  12:select2s=7 


elseif  mon$="c"  or  mon$="C"  then 

blink=  1 6:highlight=  1 4:normal=7:bground=0:border=0:quescolor=  1 5 
keyline=  1  :keylettr=7  :ptrcolor=  1 2:rcspbar=7  :resplettr=  1 
keyline2=3:keylettr2=l  :ssnbox=9 
dotcolor=2:otherscm=l  12:otherfram=-32 

REM  definition  routine  colors 


defkeyline=3:defkeylettr=0:deflf=-116:defls=48 
def2f=-32:def2s=l  13:selectlf=-23:select2f=-l  16:select2s=48 


else 

goto  ask 
end  if 

LOCATE  , ,  0  ’turn  cursor  off 

color  normal,  bground 

FOR  1=0  TO  NM  ’  read  dx  and  treatment  data  from  data  statements 

READ  treatidx(i),  DX$(I) 

NEXT  I 

REM  If  control  is  being  returned  to  the  DENTAL  program  from  diff  then  skip  opening 
files,  reading  indexes,  and  printing  the  instructions. 


If  wherefrom$="diff'  THEN  ’from  diff 
GOTO  mainmenu 
end  if 


REM  open  random  files,  read  indexes  and  words  ( definition  routines) 


open  "r",  #1,  "def.md",  60  ’for  term  definitions 

open  "def.idx"  for  input  as  #2 

open  "r",  #3,  "disdef.md",  60  ’for  disease  definitions 

open  "disdef.idx"  for  input  as  #4 

REM  read  term  definitions  and  index 
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FOR  x=l  TO  77 

input  #2,  dindx(x,  1),  dindx(x,  2) 
input  #2,  item$(x) 

NEXT  x 
close  #2 

REM  read  disease  definitions  and  index 


for  x=l  to  34 

input  #4,  disindx(x,  1),  disindx(x,  2) 
line  input  #4,  disease$(x) 
next  x 
close  #4 

REM  Print  the  title  page. 


160  els 

color  normal,  bground 

call  box(begr,  begc,  endr,  endc)  ’draw  a  box  around  the  screen 

color  normal,  bground 

locate  3, 18:print  "Naval  Submarine  Medical  Research  Laboratory" 
locate  4,  30:print  "Groton,  Connecticut" 

LOCATE  6, 24:PR1NT  "Naval  Dental  Research  Institute" 

LOCATE  7, 29:PRINT  "Great  Lakes,  Illinois" 

LOCATE  11,  15 
color  highlight,  bground 

PRINT  "COMPUTER- ASSISTED  DIAGNOSIS  OF  DENTAL  EMERGENCIES" 
LOCATE  13,21 

PRINT  "FOR  INDEPENDENT  DUTY  HOSPITAL  CORPSMEN" 

color  normal,  bground 

LOCATE  19,  34:  PRINT  "Version  3.0." 

LOCATE  20,  35:PRINT  '  April  1989" 

LOCATE  25,  1 :  print  "Press  RETURN  to  continue."; 

X$=input$(l) 

REM  Print  the  instructions. 


180  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
’clear  the  screen  except  for  the  box 
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color  highlight,  bground 
locate  2, 33:PRINT  "Instructions" 
color  normal,  bground 

locate  4,  3:PRENT  "This  computer-assisted  program  is  designed  to  aid  you 
in  the  diagnosis  and" 

locate  5,  3:PRINT  "treatment  of  common  dental  emergencies.  As  such,  it  is 
only  advisory  and  is" 

locate  6,  3:PRINT  "not  meant  to  replace  your  first  hand  impressions  or 
judgment.  The  program  is" 

locate  7,  3:PRINT  "divided  into  three  main  sections:" 
color  highlight,  bground 

locate  9,  3:PRINT  "Diagnosis  of  Dental  Emergencies" 
color  normal,  bground 

locate  11, 3:PRINT  "Use  this  section  for  symptomatic  dental  emergencies 
only.  With  this  section,  " 

locate  12,  3:PRINT  "you  must  select  either  ";chr$(34);"not 
trauma-related"; 

print  chr$(34);"  or  ";chr$(34);"trauma-related";chr$(34); 

PRINT "  categories." 
color  highlight,  bground 

locate  14,  3:PRINT  "Differential  Diagnosis  of  Soft  Tissue  Lesions" 
color  normal,  bground 

locate  16,  3:PRINT  "Use  this  section  for  a  differential  diagnosis  of  soft 
tissue  lesions." 

locate  18,  3:color  highlight,  bground 
PRINT  "Other  Activities" :color  normal,  bground 
locate  20,  3:PRINT  "Use  this  section  for  definitions  of  terms  and 
diseases,  to  bypass  the" 

locate  21, 3:PRINT  "questions  and  procede  directly  to  specific  treatment 
recommendations,  or  to " 

locate  22,  3:PRINT  "enter  a  new  patient.  When  indicated,  press  Function 
key  9  (F9)  or  10  (F10)" 

locate  23,  3:PRENT  "for  the  Main  Menu  or  Sub-menus,  respectively." 
LOCATE  25, 1  -.print  "Press  RETURN  to  continue."; 
x$=input$(l) 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
locate  2,  3:PRINT  "The  program  is  able  to  help  you  only  by  your  accurate 
input  of  information." 

locate  3,  3:PRINT  "You  will  be  asked  to  answer  a  series  of  questions 
concerning  the  problem  at" 

locate  4,  3:PRINT  "hand.  For  each  question,  select  one  answer  that  is 
most  appropriate.  Most" 

locate  5,  3:PRINT  "questions  will  need  to  be  answered  using  the  following 
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format:" 

locate  7, 3:color  highlight,  bground 

PRINT  "  Step  1.  Use  the  up  and  down  arrow  keys  (”;chr$(24);" 
";chr$(25);")  to" 

locate  8,  3:print  "  move  the  pointer  ("; 

color  ptrcolor,  bground.print  chr$(  1 6)+chr$(  1 6); 

color  highlight,  bground:print ")  to  your  choice."  :color  normal,  bground 

locate  8,  3:PRINT 

locate  10,  3 .PRINT  "then, " 

color  highlight,  bground 

locate  12,  3:PRINT "  Step  2.  Press  the  Return  key." 
color  normal,  bground 

locate  14,  3:PRINT  "Some  questions  can  be  answered  by  just  pressing  the 
Return  key.  These  will" 

locate  15,  3:PRINT  "be  so  indicated  when  appropriate.  The 
";chr$(34);"Retum";chr$(34);"  key,  as  referred  to  in  this" 
locate  16,  3.PRINT  "program,  is  synonymous  with  the 
";chr$(34);"Enter";chr$(34);"  key." 

locate  18,  3:PRINT  "Please  select  the  areas  of  concern  from  the  various 
menus  carefully!  " 

locate  19,  3:PRINT  "Read  and  answer  the  questions  carefully!" 

LOCATE  25,  l:print  "Press  RETURN  to  continue."; 
x$=input$(l) 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
color  highlight,  bground 

locate  2,  3:PRINT  "Printing  The  Screen  Display" 
color  normal,  bground 

locate  4,  3:PRINT  "If  at  any  time  you  desire  to  print  the  screen  display 
with  your  printer,  use" 

locate  5,  3:PRINT  "the  following  sequence:" 
color  highlight,  bground 

locate  7,  8:PRINT  "Step  1.  Hold  the  Shift  key  down,  "-.color  normal, 
bground 

locate  9,  3:PRINT  "then, " 
color  highlight,  bground 

locate  11,  8:PRINT  "Step  2.  Press  the  Print  Screen  (PrtSc)  key" 
color  normal,  bground 

locate  13,  3:PRINT  "This  is  valuable  for  printing  definitions  or 
treatment  recommendations." 

locate  15,  3:color  highlight,  bground:PRINT  "Important!":color  normal, 
bground 

locate  17,  3:PRINT  "Please  examine  the  patient  carefully.  Review  the 
patient’s:" 
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locate  19,  3:PRINT  "  *  Chief  Complaint 

*  Allergies" 

locate  21,  3:PRINT  "  *  Medical  and  Dental  History"; 

*  Medications" 

locate  23,  3:PRINT  "  *  Signs  and  Symptoms 

*  Habits" 

LOCATE  25,  lrprint  "Press  RETURN  to  continue."; 
x$=input$(l) 

REM  The  routine  to  display  each  question  is  as  follows: 


CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1 ,  scrollines,  attrib ) 
Clear  the  screen  except  for  the  border. 

call  initoptions  ’  Erase  options  assigned  to  option$  from  previous 

question. 

ques$="  Question  text"  ’  Assign  question  text  to  ques$. 

option$(  1 , 1)=  "  1 .  Option  one  line  one "  ’  Assign  options  to  option$. 

option$(  1,2)="  Option  one  line  two" 

option$(2, 1)="  2.  Option  two  line  one" 

option$(3, 1)="  3.  Option  three  line  one" 

option$(4, 1)="  4.  Option  four  line  one" 

longest=26  ’  Assign  length  of  longest  option  to  longest. 

numops=4  ’  Assign  number  of  options  to  numops. 

qrow=2  ’  Row  to  locate  cursor  to  print  question. 

qcol=5  ’  Column  to  locate  cursor  to  print  question. 

call  priques((ques$))  ’  Call  subroutine  to  print  the  question.  Put 

parenthesis  around  ques$,  so  that  it  will  be  passed  by  value.  Priques  will 
change  it,  so  it  shouldn  t  be  passed  by  reference. 

call  prioptions  '  Call  subroutine  to  print  options. 

ans=0  ’  Set  ans  (variable  used  in  getresp)  to  zero, 

call  getresp  'Call  subroutine  to  get  response  from  user.  Response  is 

assigned  to  ans. 

if  ans=67  then  'Branch  to  appropriate  menu  ifF9  or  F10  keys  were 

pressed. 

goto  mainmenu 
elseifans=681  then 
goto  not  trauma 
elseif  ans=682  then 
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goto  trauma 

end  if 

old  variable  name=ans  ’  Assign  ans  to  old  variable  left  over  from 

previous  versions  of  the  program  ( this  is  necessary  in  order  for  the  computer 
to  make  a  diagnosis). 

response(3)=old  variable  name  ’  Assign  old  variable  to  response  array. 

pause  != timer +.5  ’  Pause  for  a  little  while  before  clearing  the  screen 

and  displaying  a  new  question. 

do  while  TIMER  pause! 

loop 

REM  Ask  if  this  case  is  real  or  simulated. 


getsocsec: 

els 

call  box  (begr,  begc,  endr,  endc) 
call  initoptions 
ques$="This  case  is:" 
option$(l,  1)="  1.  Real" 
option$(2,  1)="  2.  Simulated" 

longest=13 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 
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if  ans=l  then 

realcase=l  { 

else 

realcase=0 
end  if 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

REM  if  this  is  a  real  case  then  get  the  patient’s  social  security  number  and  age  from  the 
user. 


if  realcase=l  then  '  real  case 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  getssn 
end  if 


pause!=timer+.5 

do  while  TIMER  pause! 

loop 


REM  Print  the  main  menu.  The  PRIOPTIONS  subroutine  isn’t  used  because  of  the 
sub-headings  for  the  menu,  and  the  highlighted  word  in  option  #1. 


mainmenu: 

call  box  (begr,  begc,  endr,  endc) 
wherefrom$="dental" 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
locate  25,  1  :color  keyline,  keyline  ’print  blank  instruction  line 

print  space$(80); 
color  normal,  bground 

850  call  initoptions  ’initialize  option$ 

locate  2,  35 

color  highlight,  bground:PRINT  "Main  Menu":color  normal,  bground 

count=l:oprow=4:opcol=17:ptrcol=opcol-5 

locate  oprow,  ptrcol 
color  highlight,  bground 


DENTAL  Programmer’s  Manual  A-16 


PRINT  "Diagnosis  of  Dental  Emergencies":color  normal,  bground 
oprow=oprow+2 

locate  oprow,  ptrcolrcolor  ptrcolor,  bgroundrprint  ptr$:color  normal, 
bground 

locate  oprow,  opcol:PRINT "  1.  Discomfort  or  Pain,  ";:color  highlight, 
bground:print"NOT";:color  normal,  bgroundrprint "  Trauma-related" 
opline(count)=oprow  :count=count+ 1  :oprow=oprow+2 
locate  oprow,  opcolrPRINT "  2.  Discomfort  or  Pain,  Trauma-related" 
opline(count)=oprow:count=count+ 1  :oprow=oprow+2 
locate  oprow,  ptrcolrcolor  highlight,  bgroundrPRINT  "Differential 
Diagnosis  of  Soft  Tissue  Lesions":color  normal,  bground 
oprow=opnow+2 

locate  oprow,  opcolrPRINT "  3.  A  Clinical  Change  in  Oral/Facial  Tissues" 
opline(count)=oprow:count=count+ 1  :oprow=oprow+2 
locate  oprow,  ptrcolrcolor  highlight,  bgroundrPRINT  "Other 
Activities":color  normal,  bground 
oprow=oprow+2 

locate  oprow,  opcolrPRINT  "  4.  Definitions" 
opline(count)=oprow:count=count+ 1  :oprow=oprow+2 
locate  oprow,  opcolrPRINT  "  5.  Treatment  Recommendations" 
opline(count)=oprow:count=count+l:oprow=oprow+2 
locate  oprow,  opcolrPRINT  "  6.  Enter  a  New  Patient" 
opline(count)=oprow:count=count+l:oprow=oprow+2 
locate  oprow,  opcolrPRINT  "  7.  Quit" 
opline(count)=oprow 

REM  Assign  options  to  option$for  GETRESP  subroutine. 


option$(l, 

option$(2, 

option$(3, 

option$(4, 

option$(5, 

option$(6, 

option$(7. 


1)=  "  1 .  Discomfort  or  Pain,  NOT  Trauma-related" 
1)=  "  2.  Discomfort  or  Pain,  Trauma-related" 

1)=  "  3.  A  Clinical  Change  in  Oral/Facial  Tissues" 
1)=  "  4.  Definitions" 

1)=  "  5.  Treatment  Recommendations" 

1)=  "  6.  Enter  a  New  Patient" 

1)=  "  7.  Quit" 


GOSUB  32400  ’  initialize  all  answer  variables  to  zero 


longest=45 

numops=7 

ans=0 


xx=0 

mmenu=0 
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call  getresp 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 


XX=ans 

response(l)=XX 

REM  Assign  response  to  mmenu.  Mmenu  is  used  to  determine  what  submenu  should  be 
displayed  when  the  user  presses  the  "F10"  key. 


mmenu=ans 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 

REM  Branch  according  to  response  from  main  menu  (before  printing  instruction  line). 


IF  XX=  4  THEN 
goto  defmenu 
end  if 

IF  XX  =  5  THEN 
call  seetrtmts 
goto  mainmenu 
end  if 

IF  XX=  6  THEN 
GOTO  getsocsec 
end  if 

IF  XX=7  THEN  GOTO  15230 

REM  Print  instruction  line  at  bottom  of  screen. 


locate  25,  hcolor  keyline,  keylinerprint  space$(80); 
locate  25,  5:color  normal,  bgroundrprint "  F9  ";:color  keylettr, 
keylinerprint Main  Menu"; 

locate  25,  26::color  normal,  bgroundrprint "  F10  ";:color  keylettr, 
keylinerprint Sub-menu"; 

locate  25,  47::color  normal,  bgroundrprint "  F7  ";:color  keylettr, 
keylinerprint Defimtioas"; 
colo”  normal,  bground 
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REM  Branch  according  to  response  from  main  menu  (after  printing  instruction  line). 


IF  XX=  1  THEN  GOTO  1450 
IF  XX=  2  THEN  GOTO  8470 
IF  XX=  3  THEN  GOTO  1880 


REM  Display  definitions  submenu  and  call  appropriate  definition  routine. 


defmenu: 

call  box(begr,  begc,  endr,  endc) 
locate  25,  l:color  keyline,  keyline:print  space$(80); 
locate  25,  5:color  normal,  bgroundrprint "  F9  ";:color  keylettr, 
keyline:print Main  Menu"; 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

count=l:oprow=4:opcol=27:ptrcol=opcol-5 

locate  2,  32:color  highlight,  bground:PRINT  "Definitions  Menu":color 
normal,  bground 

locate  oprow,  ptrcokcolor  ptrcolor,  bground: print  ptr$:color  normal, 
bground 

locate  oprow,  opcokprint "  1 .  Definitions  of  diseases" 
opline(count)=oprow:count=count+ 1  :oprow=oprow+2 
locate  oprow,  opcokprint "  2.  Definitions  of  Terms" 
opline(count)=oprow:count=count+ 1  :oprow=oprow+2 
option$(l,  1)=  "  1.  Definitions  of  diseases" 
option$(2, 1)=  "  2.  Definitions  of  Terms" 

longest=27 
numops=2 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
end  if 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 
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dmenu=ans 


IF  dmenu=l  THEN 
els 

call  diseasedefinitions 
elseif  dmenu=2  THEN 
els 

call  definitionroutine 
end  if 

GOTO  defmenu 

REM  Display  Dental  Emergencies  Menu,  Not  Trauma  Related,  and  get  users  response 


nottrauma: 

call  box  (begr,  begc,  endr,  endc) 

1450  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrolUnes.attrib) 
call  initoptions  'initialize  option$  array 
locate  2,  18:color  highlight,  bground 

PRINT  "Dental  Emergencies  Menu,  Not  Trauma-related"  :color  normal,  bground 
option$(l,  1)=  "  1.  Tooth,  Specific" 

option$(2,  1)= "  2.  Teeth,  Generalized  or  Multiple  Adjacent" 
option$(3,  1)=  "  3.  Gingiva,  Specific  Area" 
option$(4,  1)=  "  4.  Gingiva,  Generalized" 
option$(5,  1)=  "  5.  Oral  Mucosa,  Tooth-associated" 
option$(6, 1  )=  "  6.  Other  Oral  Soft  Tissues" 
option$(7,  1)=  "  7.  Temporomandibular  Joint/Muscles" 
option$(8,  1)=  "  8.  Dental  Extraction  Site" 
option$(9,  1)=  "  9.  Tissue  Swelling" 

tempresponse=response(l)  'save  response(l),  response  for  main  menu 
before  erasing  response  array 

GOSUB  32400  'initialize  answer  variables  to  zero 
response(  1  )=tempresponse 

longest=40 

numops=9 

qrow=2 

qcol=5 

call  prioptions 
ans=0 
call  getresp 
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REM  IfF9  or  F10  were  pressed  then  branch  to  appropriate  menu 


if  ans=67  then 
goto  mainmenu 
elseif  ans=68 1  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


x=ans 

response(2)=X 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

REM  Branch  according  to  user’s  response  from  Not  Trauma-related  Menu 


IF  X=1  THEN 
IF  X=2  THEN 
IF  X=3  THEN 
IF  X=4  THEN 
IF  X=5  THEN 
IF  X=6  THEN 
IF  X=7  THEN 
IF  X=8  THEN 
IF  X=9  THEN 


GOTO  5300 
GOTO  3210 
GOTO  5250 
GOTO  5250 
GOTO  5300 
GOTO  1790 
GOTO  7 140 
GOTO  1920 
GOTO  5250 


REM  Branch  here  if  Other  Oral  Soft  Tissues  (option  # 6  from  Not  Trauma-related  Menu) 
was  chosen.  Refer  user  to  DIFF  program. 


1790  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
LOCATE  7,  5. PRINT  "This  program  can  only  diagnose  conditions  that  are 
associated  with  the  teeth  "; 

LOCATE  8,  3:PRENT  "or  gingiva  (gums)  or  otherwise  specified  on  the  Main 
Menu  and  which  have"; 

LOCATE  9,  3:PRINT  "signs  or  symptoms  consistent  with  common  dental 
emergency  conditions.  Please"; 

LOCATE  10,  3:PRINT  "re-examine  the  patient  and  review  your  findings. 

Make  sure  you  have  not”; 

LOCATE  11,  3:PRINT  "selected  inconsistent  answers  to  questions.  You  are 
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being  returned  to  the"; 

LOCATE  12,  3:PRINT  "Main  Menu.  The  Soft  Tissue  Lesions  Section  (No.  3) 
can  be  used  to  obtain"; 

LOCATE  13, 3:PRINT"a  differential  diagnosis  of  the  condition  should  this 
be  unsuccessful."; 

locate  25, 1  :print  space$(80); 

LOCATE  25, 1:  print  "Press  RETURN  to  continue."; 
x$=input$(l) 

GOTO  mainmenu 

REM  Run  DIFF  program  (option  U3  from  Main  Menu). 


1880  CALL  SCROLLUP  (BEGR+1,  BEGC-t-1,  ENDR-1,  endc-1,  scrollines,  attrib) 

locate  25,  l:color  normal,  bground  'clear  instruction  line 
print  space$(80); 
chain  "DIFF" 

REM  Dental  Extraction  site  Not  Trauma-realted  (option  #8  from  NotTrauma- related 
Menu ) 


1920  GOSUB  2530  'pain  subroutine 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Which  of  the  following  most  closely  approximates  when" 

ques$=ques$+"  the  extraction  was  performed?" 

option$(l,  1)="  1.  3  to  5  days  ago" 

option$(2,  1)="  2.  6  days  to  4  weeks  ago" 

option$(3,  1)="  3.  From  4  to  8  weeks  ago" 

option$(4,  1)="  4.  None  of  the  above" 

longest=26 

numops=4 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 
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if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

Dl=ans 

response(3)=Dl 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Which  of  the  following  characterizes  the  problem  associated" 
ques$=ques$+"  with  the  extraction  site  area?" 

option$(l,  1)="  L  A  steady  pain  in  the  extraction  site  area.  The  patient 
may" 

option$(l,  2)=”  have  an  earache  on  the  same  side." 
option$(2, 1)="  2.  A  small,  well-demarcated  area  that  is  tender  to  touch 
and  which" 

option$(2,  2)="  feels  like  there  is  something  sharp  or  jagged  under  the 
tissue" 

option$(3,  1)="  3.  A  localized  diffuse  swelling  which  may  be  fluctuant  or" 

option$(3,  2)="  have  purulence  evident." 

option$(4,  1)="  4.  None  of  the  above/other" 

longest=68 

numops=4 

qrow=2 

qcol=5 

call  priques((ques$)) 

call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
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goto  trauma 

end  if  I 


D2=ans 

response(4)=D2 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Was  the  dental  extraction  site  associated  with  a  lower  posterior 
tooth?" 

option$(  1 , 1)="  1.  Yes" 

option$(2,  1)="  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


D3=ans 

response(5)=D3 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

REM  Set  cell  in  Z  array  that  corresponds  to  a  certain  diagnosis  to  1  (probable)  or  2 
( possible )  depending  on  responses  to  previous  questions. 
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IF  (Dl=l)  AND  ((D2=l)  OR  (PN  1)  OR  (D3=l))  THEN  Z(l)=2 
IF  (Dl=l)  AND  (D2=l)  AND  (D3=l)  AND  (PN  1)  THEN  Z(l)=l 
IF  (D2=2)  AND  ((Dl  l)OR(PN  3))  THEN  Z(2)  =2 
IF  (Dll)  AND  (D2=2)  AND  (D14)  AND  (PN3)  THEN  Z(2)=l 
IF  (D2=3)  AND  ((DU  3)OR(Dl  3))  THEN  Z(3)  =2 
IF  (D2=3)  AND  (DU=1)  AND  (Dl  3)THENZ(3)=1 
IF  Z(3)=l  OR  Z(3)=2  THEN  GOTO  3170 
GOTO  11810 

2430  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="The  patient  has  had  a  similar  problem" 

option$(l,  1)=  "  1.  Once  previously" 

option$(2, 1)= "  2.  Off-and-on" 

option$(3,  1)= "  3.  Never  before" 

longest=21 

numops=3 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

TM=ans 

response(6)=TM 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

2530  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="How  long  has  the  immediate  problem  lasted?" 
option$(l,  1)=  "  1.  For  the  last  few  days" 
option$(2,  1)=  "  2.  For  the  last  few  weeks" 
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option$(3, 1)=  "  3.  Long  standing" 

longest=27 

numops=3 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

DU=ans 

response(7)=DU 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
GOTO  2740 

2650  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="When  present,  the  pain  has  lasted" 

option$(l,  1)=  "  1.  Less  than  an  hour." 

option$(2,  1)=  "  2.  An  hour  or  longer." 

longest=23 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 


DENTAL  Programmer’s  Manual  A-26 


if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


HR=ans 

response(8)=HR 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

RETURN 

2740  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="The  degree  of  discomfort  is" 
option$(l,  1)="  1.  Mild." 
option$(2,  1)=  "  2.  Moderate.” 

option$(3,  1)=  "  3.  Severe  (interferes  with  sleep  or  work)." 

longest=44 

numops=3 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


PN=ans 

response(9)=PN 
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pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 

EF  G=1  OR  P10  OR  X=3  OR  X=4  OR  X=7  OR  X=8  OR  X=9  THEN 

RETURN 

end  if 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$=  "The  pain  or  discomfort  is" 
option$(l,  1)=  "  1.  Continuous." 
option$(2, 1)=  "  2.  Intermittent." 

longest=19 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

CI=ans 

response(10)=CI 

pause  !=timer+,5 

do  while  TIMER  pause! 

loop 

RETURN 

REM  branch  here 
2850  IF  X=9  THEN  GOTO  2870 
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CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
2870  call  initoptions 

ques$="Is  there  a  history  of  or  evidence  in  the  patient’s  record  of 
prior  diagnosis” 

ques$=ques$+"  or  treatment  for  periodontal  disease?" 

option$(l,  1)=  "  1.  Yes" 

option$(2, 1)= "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68 1  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

PB=ans 

response(ll)=PB 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Has  the  patient  had  a  history  of  periodontal  abscesses?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)="  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 
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if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

PC=ans 

response(12)=PC 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

3050  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="In  the  area  of  concern,  is  the  probing  depth  (with  a  periodontal 
probe) " 

ques$=ques$+"  greater  than  4  mm?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

option$(3,  1)=  "  3.  Unable  to  determine" 

longest=23 

numops=3 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

PE=ans 

response(13)=PE 
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pause!=timer+.5 

I  do  while  TIMER  pause! 

loop 

REM  branch  here 
RETURN 

3170  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scroUines,  attrib) 
LOCATE  10, 6:  PRINT  "Some  additional  questions  need  to  be  asked  about 
teeth  in  the  area."; 

locate  25,  lrprint  space$(80); 

locate  25, 2:print  "Press  RETURN  to  continue"; 

x$=input$(l) 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
REM  put  key  line  back 


locate  25, 1  :color  keyline,  keylinerprint  space$(80); 
locate  25,  5:color  normal,  bgroundrprint "  F9  ";:color  keylettr, 
keyline:print  ”-  Main  Menu"; 

locate  25,  26::color  normal,  bgroundrprint "  F10  ";:color  keylettr, 
keylinerprint Sub-menu"; 

|  locate  25,  47::color  normal,  bgroundrprint "  F7  color  keylettr, 

keylinerprint DeFmitions"; 
color  normal,  bground 

REM  Teeth  Generalized  or  Multiple  Adjacent  Not  Trauma-related  ( Option  #2from  Not 
Trauma-related  Menu ) 


3210  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
IF  (PN=1)  OR  (PN=2)  OR  (PN=3)  THEN  GOTO  3240 
GOSUB  2740 

3240  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Is  there  significant  discomfort  when  the  area  is  exposed  to  hot 
or  cold?" 

option$(l,  1)="  1.  Yes" 
option$(2,  1)=  "  2.  No" 

option$(3, 1)=  "  3.  Not  at  present,  but  very  recently" 

longest=38 

numops=3 

qrow=2 
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qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


El=ans 

response(14)=El 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  (El  =2)  THEN  GOTO  3590 

3350  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 
IF  (El =1 )  THEN 

ques$="Does  the  discomfort  linger  after  exposure  to  hot  or  cold  (as 
opposed  to" 

elselF  (El  =3)  THEN 

ques$="Did  the  discomfort  linger  after  exposure  to  hot  or  cold  (as 
opposed  to" 
end  if 

ques$=ques$+"  going  away  immediately  after  removal  of  the  hot  or  cold)?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
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call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

E2=ans 

response(15)=E2 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  (El  =3)  THEN  GOTO  3590 

3460  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Is  exposed  dentin  present  or  is  the  discomfort  primarily  to  cold 
or  touch" 

ques$=ques$+"  and  located  near  the  gingival" 

IF  (X=2)  OR  (X=4)  THEN 
ques$=ques$+"  (gum  tissue)  margins?" 
else 

ques$=ques$+"  (gum  tissue)  margin?" 
end  if 

option$(l,  1)= "  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 
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if  ans=67  then 
goto  mainmenu 
elseif  ans=68l  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

E6=ans 

response(16)=E6 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  X=2  THEN  GOTO  3690 

3590  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$=  "Is  the  pain  spontaneous  (occur  for  no  particular  reason)?" 

option$(l,  1)=  "  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68l  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

E3=ans 

response(17)=E3 
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pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  (E  1=1)  THEN  GOSUB  2650 

3690  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$=  "Do  eating  sweets  or  sugar  elicit  the  pain?" 
option$(l,  1)= "  1.  Yes" 
option$(2,  1)=  "  2.  No" 
option$(3, 1)=  "  3.  Not  known" 

longest=14 

numops=3 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

E4=ans 

response(18)=E4 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  X=2  THEN  GOTO  3910 

3800  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Do  caries  (decay)  appear  associated  with  the  tooth  either 
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clinically" 

ques$=ques$+"  or  on  an  old  radiograph?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

option$(3,  1)=  "  3.  Not  known" 

longest=14 

numops=3 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getrcsp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

E5=ans 

response(19)=E5 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

3910  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 
IF  X=2  THEN 

ques$="Are  the  teeth  sensitive  to  percussion?" 
else 

ques$="Is  the  tooth  sensitive  to  percussion" 
end  if 

ques$=ques$+"  (tapping  with  a  metal  instrument  or  biting)?" 

option$(l,  1)=  "  1.  Yes” 

option$(2,  1)="  2.  No" 

longest=8 

numops=2 

qrow=2 
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qcol=5 

call  priques((ques$» 
call  prioptions 
ans=0 
call  getrcsp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

E7=ans 

response(20)=E7 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

4030  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 
IF  (X=2)  THEN 

ques$="Is  there  discomfort  when  the  area  near  the  apices  (ends)  of  the 
teeth  are" 
else 

ques$=  "Is  there  discomfort  when  the  area  near  the  apex  (end)  of  the 
tooth  is" 
end  if 

ques$=ques$+"  palpated?" 

option$(l,  1)="  1.  Yes" 

option$(2, 1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 
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if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  not  trauma 
elseif  ans=682  then 
goto  trauma 
end  if 

E8=ans 

response(21)=E8 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 
IF  X=9  THEN 

ques$=  "Is  the  swelling  primarily  located  near  the  apical  areas  (ends) 
of  adjacent" 

ques$=ques$+"  teeth  or  is  a  fistula  present?" 
else 

ques$="Is  a  fistula,  fluctuant  swelling,  or  localized  diffuse 
inflammatory  swelling” 

IF  (X=2)  THEN 

ques$=ques$+"  present  near  the  apices  (ends)  of  the  teeth?" 
else 

ques$=ques$+"  present  near  the  apex  (end)  of  the  tooth?" 
end  if 
end  if 

option$(l,  1)=  "  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 
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if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

E9=ans 

response(22)=E9 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  (X=2)  THEN  GOTO  4600 

4310  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Has  the  tooth  had  prior  endodontic  (root  canal)  treatment  either 
started  or" 

ques$=ques$+ "  completed?" 

option$(l,  1)=  "  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 
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EB=ans 

response(23)=EB 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  PF=1  THEN  GOTO  4910 

4420  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Does  a  restoration  (filling)  appear  defective  in  the  area  of 
concern?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68 1  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

EC=ans 

response(24)=EC 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

4500  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 
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ques$="Is  there  clinical  evidence  of  a  fracture  line  or  crack  in  the 
tooth?" 

option$(l,  1)="  1.  Yes" 

option$(2, 1)="  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68 1  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


EE=ans 

response(25)=EE 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  EE=1  THEN  TW=1 
IF  Z(3)=l  OR  Z(3)=2  THEN  GOTO  4860 

4600  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Is  the  problem  located  in  the  maxillary  posterior  teeth?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 
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qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getrcsp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


EG=ans 

response(26)=EG 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  EG=2  THEN  GOTO  4860 

4690  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Does  the  discomfort  increase  when  the  patient  bends  over 
(lowering  the" 

ques$=ques$+"  position  of  the  head)?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)="  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getrcsp 
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if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

EI=ans 

response(27)=EI 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

4780  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Has  the  patient  recently  had  a  cold  or  sinus  problem?" 

option$(l,  1)=  "  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


EH=ans 

response(28)=EH 

pause!=timer+.5 
do  while  TIMER  pause! 


DENTAL  Programmer's  Manual  A-43 


loop 


REM  Set  cell  in  Z  array  that  corresponds  to  a  certain  diagnosis  to  1  (probable)  or  2 
( possible )  depending  on  responses  to  previous  questions. 


4860  IF  (E9=l)  THEN  GOSUB2850 
4870  GOSUB  8210 

IF  TF=1  THEN  GOTO  4910 
IF  ZZ=1  THEN  GOTO  4910 

IF  CI=1  AND  PNol  AND  E7=2  AND  E9=2  AND  EB=2  AND  E8=2  THEN  Z(6)=2 
IF  (X=2)  OR  ((EA=1)  OR  (NF=1))  AND  (M  o  1)  AND  (E9  <>  1)  AND  (El  o  1) 

AND  (E2  o  1)  THEN  GOSUB  7900 

4910  IF  ((P7=l)  AND  (E2  o  1))  OR  ((E9=l)  AND  (E2  o  1)  AND  ((PE=1)  OR  (PB=1) 
OR  (PC=1)))  THEN  Z(4)=2 

IF  (((P7=l)  AND  (P8=l))  OR  (E9=l))  AND  ((PE=I)  OR  (PC=1))  AND  (E2  <>  1) 

AND  ((EC  o  1)  OR  (E5  <>  1))  AND  (EB  <>  1)  AND  (E7=l)  THEN  Z(4)=l 

IF  (El=l)  AND  (E2=2)  AND  (E9=2)  AND  ((E3=2)  OR  (NF=1))  THEN  Z(5)=2 
IF  ((El=l)  AND  (E2=2)  AND  (E3=2)  AND  (E9=2)  AND  (HR  <>  2))  OR  ((NF=1) 

AND  (El=l)  AND  (E7=l)  AND  (E9=2))  THEN  Z(5)=l 

IF  (((El=l)  AND  (E2=l))  OR  ((E3=l)  AND  (PN=3)))  AND  (PN  <>  1)  AND  ((El  <> 

1)  OR  (EH  <>  1»  THEN  Z(6)=2 

IF  CI=1  AND  HRol  AND  PNol  AND  E7=2  AND  E8=2  AND  EBol  THEN  Z(6)=2 
IF  (((El=l)  AND  (E2=l))  OR  (E3=l))  AND  (PN=3)  AND  (NF=2)  AND  (HR=2)  AND 
(P7  o  1)  AND  (P8  o  1)  THEN  Z(6)=l 

IF  (E9=l)  AND  ((E7=l)  OR  (E8=l)  OR  (PE  o  1)  OR  (PB  o  1)  OR  (PC  o  1)) 

THEN  Z(7)=2 

IF  (E7=l)  AND  (E9=l)  AND  ((EB=1)  OR  (E2=l)  OR  (E5=l)  OR  (EC=1)  OR  (E8=l) 
OR  (EA=1))  AND  (PE  o  1)  AND  (PB=2)  OR  (PC=2)  THEN  Z(7)=l 

IF  (X  o  2)  AND  ((E7=l)  OR  (E8=l))  AND  ((El  o  1)  OR  (EH  o  1))  AND  (P7 
o  1)  AND  (P8<>1)  AND  (E9=2)  THEN  Z(8)=2 

IF  (X=2)  AND  ((E7=l)  OR  (E8=l))  AND  ((El  o  1)  OR  (EH  o  1))  AND  (P7  o 
1)  AND  (P8<>1)  AND  (E9=2)  THEN  Z(8)=2 

IF  (X  o  2)  AND  (E7=l)  AND  (E8=l)  AND  (EE  o  1)  AND  (El  o  1)  AND  (E9=2) 
AND  (P7ol)  AND  (P8  o  1)  AND  ((E3  o  1)  OR  (EH  o  1))  THEN  Z(8)=l 
IF  (E4=l)  OR  (E5=l)  THEN  Z(9)=2 
IF  (E5=l)  THEN  Z(9)=l 

IF  (((El=l)  AND  (E2=2)  AND  (E6=l))  OR  (E4=l)  AND  (E9=2))  OR  ((X=2)  AND 
((E4=l)  OR  (E6=l))  AND  (E9=2))  THEN  Z(10)=2 

IF  (E 1 = 1 )  AND  (E2=2)  AND  (E3=2)  AND  ((E6=l)  OR  (E4=l))  AND  (E7=2)  AND 
(E8=2)  AND  (E9=2)  AND  (HR=1)  THEN  Z(10)=l 

IF  ((EH=1)  OR  (EI=1))  AND  (EG=1)  AND  (E9=2)  AND  (E2ol)  THEN  Z(1 1)=2 
IF  (EG=1)  AND  (EI=1)  AND  (EH=1)  AND  (El  o  1)  AND  ((E7=l)  OR  (E8=l)  OR 
(NF=1))  AND  (E9  o  1)  THEN  Z(ll)=l 
IF(EC=1)THENZ(13)=2 
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IF  (EOl)  AND  ((El=l)  OR  (E6=l))  THEN  Z(13)=l 

IF  ((E9=l)  OR  ((P7=l)  OR  (P8=l)))  AND  ((E2=l)  OR  (E3=l)  OR  (EB=1))  AND 
((PE=1)  OR  ((PC=1)  OR  (PB=1)))  THEN  Z(12)=2 

IF  ((E9=l)  OR  ((P7=l)  AND  (P8=l)))  AND  (E2=l)  AND  (E7=l)  AND  ((PE=1)  AND 
((PC=1)  OR  (PB=1)))  THEN  Z(12)=l 

IF  ((E7=l)  AND  (NF=1))  OR  ((EA=1)  AND  (NF=1))  OR  ((NF=1)  AND  (X9=l))  OR 
((EA=1)  AND  (OW=l))  OR  ((OW=l)  AND  (X9=l))  OR  ((EA=1)  AND  (X8=l)  AND  (X9=l)) 
OR  ((NF=1)  AND  (OW=l))  THEN  Z(21)=2 

IF  (((E7=l)  AND  (NF=1))  OR  ((EA=1)  AND  (OW=l))  OR  ((X9=I)  AND  (OW=l))  OR 
((EA=1)  AND  (X8=l)  AND  (X9=l))  OR  ((NF=1)  AND  (OW=l)  AND  (E7=l)))  AND  (E9  o 
1)  AND  (El  o  1)  AND  (E2  o  1)  THEN  Z(21)=l 

IF  (El=l)  AND  (EE=1)  AND  ((E7=l)  OR  (EB=1)  OR  (E9=2)  OR  (EC=1))  THEN 
GOTO  11070 

IF  Z(11)=I  THEN  Z(8)=0 
IF  Z(12)=l  THEN  Z(4)=2 
IF  Z(12)=l  THEN  Z(7)=2 
IF  Z(4)=2  THEN  Z(7)=2 
IF  Z(7)=2  THEN  Z(4)=2 
IF  Z(4)=l  THEN  Z(7)=2 
IF  Z(7)=l  THEN  Z(4)=2 
IF  Z(10)=l  THEN  Z(5)=2 
GOTO  11810 

REM  Gingiva  Specific,  Gingiva  Generalized,  and  Tissue  Swelling,  not  trauma-related 
( options  3,  4  and  9  from  Not  Trauma-related  Menu). 


5250  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 

IF  X=9  THEN  GOTO  6010 

GOSUB  2430 

IF  X=4  THEN  GOTO  5510 

REM  Tooth  specific  and  oral  mucosa  tooth-associated,  not  trauma-related  (options  1  and 
5  from  Not  Trauma-related  Menu). 


5300  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Does  the  area  of  concern  appear  to  be  either  a  flap  of  inflamed 
tissue " 

ques$=ques$+"  partially  covering  an  erupting  tooth  or  an  area  of  tissue 
(not  always  grossly" 

ques$=ques$+"  inflamed)  surrounding  an  erupting  tooth?" 


I 


DENTAL  Programmer’ s  Manual  A-45 


option$(l,  I)=  "  1.  Yes 


option$(2, 1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

Pl=ans 

response(29)=Pl 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 

IF  ((X=l)  OR  (X=5))  AND  (PI  =2)  THEN  GOTO  3210 
IF  Pl=2  THEN  GOTO  5510 

5420  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Is  the  tooth  a  3rd  molar  (wisdom  tooth)?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 


DENTAL  Programmer’ s  Manual  A-46 


ans=0 
call  getrcsp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

UZ=ans 

response(30)=UZ 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 

IF  ((X=l)  OR  (X=5))  THEN  GOSUB  2430 

5510  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Aside  from  possible  racial  pigmentation,  which" 
ques$=ques$+"is  a  normal  finding  if  present,  what  is  the  color  of' 
ques$=ques$+"  the  gingival  tissues  (gums)?" 

option$(l,  1)="  1.  Pink" 

option$(2,  1)=  "  2.  Red" 

option$(3,  1)=  "  3.  Pink  with  red  gingival  margins" 

option$(4,  1)=  "  4.  Either  No.  2  or  No.  3  above,  but  with  areas  having  a" 

option$(4,  2)=  "  gray-white  membranous  coating  that  can  be  easily 
removed" 

longest=54 

numops=4 

qrow=2 

qcoI=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
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call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

P2=ans 

response(31)=P2 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

5650  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 
IF  X=3  THEN 

ques$="In  the  area  of  concern,  do" 
else 

ques$="Do" 
end  if 

ques$=ques$+  "  the  gingival  (gum)  tissues  bleed  when  probed  or  does  the 
patient" 

ques$=ques$+"  report  bleeding  when  brushing?" 

option$(l,  1)=  "  1.  Yes" 

option$(2, 1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
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elseif  ans=682  then 
goto  trauma 
end  if 

P3=ans 

response(32)=P3 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  UZ=1  THEN  GOTO  6990 

5780  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 
IF  X=3  THEN 

ques$="In  the  area  of  concern,  do" 
else 

ques$="Do" 
end  if 

5790  ques$=ques$+”  the  gingival  papillae  appear" 

option$(l,  1)=  "  1.  Scalloped  and  not  swollen  (normal)?" 

option$(2,  1)=  "  2.  Swollen  and  enlarged?" 

option$(3,  1)=  "  3.  Ulcerated  or  blunted?" 

longest=41 

numops=3 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 
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P4=ans 

response(33)=P4 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

5910  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initopdons 

ques$='Ts  an  extremely  foul  odor  present?" 

option$(l,  1)="  1.  Yes" 
option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

P5=ans 

response(34)=P5 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
GOTO  6130 

6010  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initopdons 

ques$=  "The  swelling  is  located  on  the" 
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option$(l,  1)= "  1.  Face.” 

option$(2, 1)=  "  2.  Oral  mucosa  or  gingiva,  near  teeth." 

option$(3,  1)= "  3.  Other  oral  tissues,  not  near  teeth." 

longest=40 

numops=3 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68 1  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

SW=ans 

response(35)=SW 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

IF  ((SW  1)  OR  (SW  3))  THEN  GOTO  6010 

REM  branch  here 
IF  SW=3  THEN  GOTO  1790 
IF  X=9  THEN  GOSUB  2530 

6130  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Does  the  patient  have  an  elevated  temperature,  palpable  lymph 
nodes  of’ 

ques$=ques$+"  the  head  and  neck  region,  or  malaise?" 

option$(  1 ,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 
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qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

P6=ans 

response(36)=P6 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  (SW=2)  THEN  GOTO  6370 
EF  X=4  THEN  GOTO  6810 
IF  SW=1  THEN  GOTO  6370 

6260  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Is  a  very  prominent,  but  localized,  swelling  of  the  gingival  or 
mucosal " 

ques$=ques$+"  tissues  present?" 

option$(l,  1)=  "  1.  Yes" 

option$(2,  1)="  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 
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if  ans=67  then 
goto  mainmenu 
elscif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


P7=ans 

response(37)=P7 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  P7=2  THEN  GOTO  6500 

6370  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Does  the  swelling  have  a  diffuse  inflammatory  appearance,  or" 
ques$=ques$+"  does  the  swelling  appear  to  be  fluctuant,  or" 
ques$=ques$+"  is  there  evidence  of  a  purulent  exudate  (pus)?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 
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P8=ans 

response(38)=P8 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 

IF  (P7=l)  AND  (P8=2)  THEN  GOSUB  2850 

IF  (P7=l)  AND  (P8=2)  AND  (PC=2)  AND  (PEI)  AND  (PB=2)  THEN  GOTO  1790 
IF  ((SW=2)  OR  (P7=l))  AND  (P8=l)  THEN  GOTO  6910 

6500  IF  X=9  THEN  GOTO  6990 

6510  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Do  the  teeth  feel  tight  or  like" 
ques$=ques$+"  something  is  caught  between  them?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


P9=ans 

response(39)=P9 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 
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6610  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Does  the  patient  relate  a  history  of  food  being  trapped  or 
caught" 

ques$=ques$+"  between  the  teeth  in  the  area  of  concern?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


PG=ans 

response(40)=PG 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  P5=l  THEN  GOTO  6810 

6720  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$=”Does  the  patient  complain  of  a  bad  taste  or  odor  in  his  (or  her) 
mouth?" 

option$(l,  1)="  1.  Yes” 
option$(2,  1)=  "  2.  No" 
longest=8 
numops=2 
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qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getrcsp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


PV=ans 

response(41)=PV 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

6810  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Does  the  patient  have  shallow,  ragged,  painful  ulcers  covered  by 
a  gray/white" 

ques$=ques$+"  membrane  and  surrounded  by  a  reddish  halo?" 

option$(l,  1)="  1.  Yes" 

option$(2, 1)="  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
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goto  trauma 
end  if 


PH=ans 

response(42)=PH 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 

IF  (P7=l)  AND  (P8=2)  THEN  GOTO  6920 

6910  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
6920  IF  X=9  THEN 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
locate  10, 6:color  highlight,  bground:print  "Note:";:color  normal, 
bground 

PRINT  "  Some  of  the  following  questions  refer  to  teeth  in  the 
immediate" 

locate  11, 6:PRINT  "area  of  the  swelling.”; 

locate  25,  Lprint  space$(80); 

locate  25,  2:print  "Press  RETURN  to  continue”; 

x$=input$(I) 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
REM  put  key  line  back 


locate  25,  lrcolor  keyline,  keyline:print  space$(80); 
locate  25,  5:color  normal,  bground:print "  F9  ";:color  keylettr, 
keylinerprint "-  Main  Menu"; 

locate  25,  26::color  normal,  bground:print "  F10  ";:color  keylettr, 
keylinerprint "-  Sub-menu"; 

locate  25,  47::color  normal,  bgroundrprint  "  F7  ";:color  keylettr, 
keylinerprint Definitions"; 
color  normal,  bground 

end  if 

IF  ((SW=2)  OR  (P7=l))  AND  (P8=l)  THEN  GOSUB  2850 

ZZ=1 

PF=1 

IF  SW=2  THEN  P7=l 

IF  (P7=l )  AND  (P8=2)  AND  ((PB=1)  OR  (PC=1)  OR  (PE=1))  THEN  GOTO  3170 

DENTAL  Programmer’ s  Manual  A-57 


IF  (P7=l)  AND  (P8=2)  THEN  GOTO  1790 
6990  IF  (Pl=l)  AND  (DU  <>  3)  THEN  Z(15)=2 

IF  (Pl=l)  AND  (P2  o  4)  AND  (DU=1)  AND  (UZ=1)  THEN  Z(15)=l 
IF  (DU  o  3)  AND  ((P2=4)  OR  (P4=3)  OR  (P5=l))  AND  (P3=l)  AND  (P7  <>  1) 
AND  (P8  o  1)  THEN  Z(16)=2 

IF  (DU=1)  AND  (P2=4)  AND  (P3=l)  AND  (P5=l)  AND  ((P6=l)  OR  (P4=3)  OR  (PN 
=3))  AND  (P7  o  1)  AND  (P8  o  1)  AND  (PH  o  1)  THEN  Z(16)=l 

IF  (DU  o  3)  AND  (P3=l)  AND  (PH=2)  AND  (P2  o  4)  AND  ((P2  o  1)  OR  (P4  < 

>  3))  AND  (PH  =2)  AND  (P7ol)  AND  (P8  <  >  1)  THEN  Z(17)=2 

IF  (DU  <>  3)  AND  ((PN=2)  OR  (PN=3))  AND  ((P2=2)  OR  (P2=3))  AND  (P3=l) 
AND  (P4=2)  AND  (P6=2)  AND  (PH=2)  AND  (P7ol)  AND  (P8  o  1)  THEN  Z(17)=l 
IF  (X=3)  AND  ((P9=l)  OR  (PG=1)  OR  (PV=1))  AND  (P2  o  4)  AND  (P8  <>  1) 
THEN  Z(18)=2 

IF  (((P9=l)  AND  (PG=1))  OR  ((P9=l)  AND  (PV=1))  OR  ((PG=1)  AND  (PV=1))) 
AND  (X=3)  AND  (P2  o  4)  AND  (P6  <>  1)  AND  (P8  <>  1)  THEN  Z(18)=l 

IF  ((DU=1)  OR  (PN  <>  1)  OR  (P6=l ))  AND  (PI  <>  1)  AND  (PH=1)  THEN  Z(14) 

=2 

IF  (DU=1)  AND  (PN  <>  1)  AND  (PI  o  1)  AND  (P2  o  4)  AND  (P6=l)  AND  (P8 
<>  1)  AND  (PH=1)  THEN  Z(14)  =1 

IF  (SW=1)  AND  ((P6=l)  OR  (P8=l))  THEN  Z(3)=2 

IF  (X=9)  AND  (DU=1)  AND  ((PN=2)  OR  (PN=3))  AND  (P6=l)  AND  (P8=l)  THEN 
Z(3)=l 

IF  (P7=l)  AND  (P8=l)  THEN  GOTO  3210 
GOTO  11810 

REM  Temporomandibular  joint/muscles  ( option  7  from  Not  Trauma-relatedMenu). 


7140  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Does  the  patient  have  clicking  or  popping  of  the 
temporomandibular  joint?" 

TQ=1 


option$(l,  1)="  1.  Yes" 

option$(2,  1)="  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 
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if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

Xl=ans 

response(43)=Xl 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

7240  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Is  the  temporomandibular  joint  tender  to  palpation  either 
facially  or  through" 

ques$=ques$+"  the  external  auditory  canal?" 

option$(l,  1)=  "  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


X2=ans 

response(44)=X2 
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pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

7340  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Are  the  muscles  of  mastication  tender  to  palpation?" 

option$(l,  1)= "  1.  Yes" 

option$(2, 1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

X3=ans 

response(45)=X3 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

7430  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Does  the  patient’s  mandible  deviate  laterally  on  opening?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)="  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 
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call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

X4=ans 

response(46)=X4 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

7520  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Is  the  patient’s  ability  to  open  his  mouth  compromised  or 
limited?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 
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X5=ans 

response(47)=X5 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

7610  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Does  the  patient  have  a  history  of  previous  temporomandibular 
joint  problems” 

ques$=ques$+"  or  treatment?" 

option$(l,  1)=  "  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

X6=ans 

response(48)=X6 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

77 1 0  CALL  SCROLLUP  (BEGR+1 ,  BEGC+ 1 ,  ENDR- 1 ,  endc- 1 ,  scrollines,  attrib) 
call  initoptions 

ques$="Has  the  patient  recently  been  under  increased  stress  (marital, 
job," 

ques$=ques$+”  financial,  legal,  health)?" 
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option$(l,  1)="  1.  Yes" 

option$(2, 1)=  "  2.  No” 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getrcsp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68 1  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


X7=ans 

response(49)=X7 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
TF=1 

IF  (X  1=1)  OR  (X2=l)  THEN  Z(20)=2 
IF  (Xl=l)  AND  (X2=l)  THEN  Z(20)=l 

IF  (X3=l)  OR  (X5=l)  OR  (X4=l)  AND  ((X6=l)  OR  (X7=l))  THEN  Z(19)=2 
IF  (X3=l)  AND  (X5=l)  AND  ((X4=l)  OR  (X6=l)  OR  (X7=l))  THEN  Z(19)=l 
GOSUB  7900 

IF  (OW=l)  OR  (X8=l)  OR(X9=l)  THEN  GOTO  4870 
GOTO  11810 

7900  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Is  there  evidence  of  significant" 

TF  X=1  THEN 

ques$=ques$+"  wear  on  the  occlusal  surface” 
else 

ques$=ques$+”  wear  on  the  occlusal  surfaces" 
end  if 
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ques$=ques$+"  (flat  spots,  facets)? 


option$(l,  1)="  1.  Yes" 

option$(2, 1)= "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  priopdons 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

OW=ans 

response(50)=OW 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

8030  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Does  the  patient  either  grind  or  clench  his  teeth  or  chew  gum 
regularly?" 

option$(l,  1)="  1.  Yes" 

option$(2, 1)="  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  priopdons 
ans=0 
call  getresp 
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if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


X8=ans 

response(51)=X8 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

8110  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 
EF  (X=l)  THEN 

ques$="Is  the  tooth  "+chr$(34)+"sore"+chr$(34)+"?" 
elselF  (X=2)  OR  (X=7)  THEN 
ques$="Are  the  teeth  "+chr$(34)+"sore"+chi$(34)+"?" 
end  if 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


X9=ans 

response(52)=X9 
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pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 

IF  (EA=1)  OR  (EA=2)  OR  (NF=1)  OR  (NF=2)  OR  (X  =2)  OR  (X=7)  THEN  RETURN 

8210  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initopdons 

IF  ((X=2)  OR  (X=7))  and  ZZ  1  THEN 
ques$="Do  the  teeth  have  increased  mobility?” 
else 

ques$="Does  the  tooth  have  increased  mobility?" 
end  if 

optionSG,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

cull  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

EA=ans 

response(53)=EA 

pause!=dmer+.5 

do  while  TIMER  pause! 

loop 

8340  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initopdons 

ques$=”Does  the  patient  have  a  brand  new  restoration  (filling)  or  dental 
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crown/” 

qucs$=ques$+"bridgework  on  or  opposing  the  sore" 
IF  (X=2)  OR  (X=7)  THEN 
ques$=ques$+"  teeth?" 
else 

ques$=ques$+"  tooth?" 
end  if 

option$(l,  1)=  "  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


NF=ans 

response(54)=NF 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

RETURN 

REM  Display  Dental  Emergencies  Menu,  Trauma-related  and  get  usersresponse. 


trauma: 

call  box  (begr,  begc,  endr,  endc) 

8470  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR- 1,  endc- 1,  scrollines,  attrib) 
call  initoptions 

locate  2,  20:color  highlight,  bground:PRINT  "Dental  Emergencies  Menu, 
Trauma-related";:color  normal,  bground 
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option$(l,  1)=  "  1.  Tooth  or  Teeth  (Evaluate  Individually)" 
option$(2, 1)=  "  2.  Other  Oral  or  Facial  Tissues  or  Structures" 
option$(3, 1)=  "  3.  Both  Teeth  and  Other  Oral  or  Facial  Tissues  or 
Structures" 

LOCATE  16, 5:  color  highlight,  bground:PRINT  "Note:";:color  normal, 
bground 

locate  17, 7:PRINT  "Trauma-related  means  associated  with  obvious 
physical  trauma  only."; 

tempresponse=response(  1 )  '  save  response(  1 ),  response  for  main  menu, 

before  erasing  response  array. 

GOSUB  32400  ' initialize  answer  variables  to  zero. 

response(  1  )=tempresponse 

longest=62 

numops=3 

qrow=2 

qcol=5 

call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68 1  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


TA=ans 

response(55)=TA 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

8610  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Ask  the  patient  to  open  and  close  while  looking  in  a  mirror. 

Examine  the" 

ques$=ques$+"  patient  carefully.  Is  the  occlusion  (bite)" 
option$(l,  1)=  "  1.  Unchanged?" 
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option$(2,  1)=  "  2.  Changed  slightly?" 

option$(3, 1)=  "  3.  Changed  appreciably?" 

longest=26 

numops=3 

qrow=2 

qcol=5 

caU  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

TB=ans 

response(56)=TB 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

8740  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Does  the  patient  have  a  head  injury  or  did  he/she  lose 
consciousness,  vomit,  or" 

ques$=ques$+"  have  a  history  of  amnesia  associated  with  the  trauma?" 

option$(  1 ,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 
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if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


C=ans 

response(57)=C 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 


IF  TA=1  THEN  GOTO  9840 

8830  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Paresthesia  or  anesthesia  (partial  or  complete  numbness),  if 
present,  is" 

ques$=ques$+"  primarily  associated  with  which  one  of  the  following:" 

option$(l,  1)=  "  1 .  Lower  teeth  and/or  lower  lip  and  chin." 
option$(2,  1)=  "  2.  Upper  teeth  and/or  upper  lip." 
option$(3,  1)=  ”  3.  Lower  eyelid  and/or  lateral  areas  of  nose  and/or 
cheek." 

option$(4, 1)=  "  4.  None  of  the  above/not  applicable." 

longest=60 

numops=4 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68 1  then 
goto  nottrauma 
elseif  ans=682  then 
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goto  trauma 
end  if 

PZ=ans 

response(58)-PZ 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

8960  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 
ques$="There  is  evidence  of' 

option$(l,  1)=  ”  1.  Enopthalmia  or  exopthalmia." 
option$(2,  1)=  "  2.  Visual  disturbances  (primarily  diplopia)." 
option$(3,  1)=  "  3.  Subconjunctival  hemorrhage  (medial  or  lateral)." 
option$(4,  1)= "  4.  Increased  intercanthal  distance  (eyes  look/feel 
further  apart)." 

option$(5,  1)=  "  5.  Visual  asymmetry  of  the  cheek." 
option$(6,  1)= "  6.  Pain  or  crepitus  when  palpating  high  into  the  buccal 
vestibule, " 

option$(6,  2)=  "  near  the  2nd  and  3rd  molars,  with  your  index 
finger.” 

option$(7,  1)=  "  7.  More  than  one  of  the  above" 

option$(8,  1)=  "  8.  None  of  the  above" 

longest=67 

numops=8 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 
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ZY=ans 

response(59)=ZY 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

9170  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initopdons 

ques$="Does  the  mandible  deviate  to  the  injured  side  when  opening?" 

option$(l,  1)=  "  1.  Yes" 

option$(2, 1)= "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

TC=ans 

response(60)=TC 

pause!  =dmer+.5 

do  while  TIMER  pause! 

loop 

9250  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initopdons 

ques$="Is  it  painful  to  open  or  close?" 

opuon$(l,  1)="  1.  Yes" 
option$(2,  1)=  "  2.  No" 
longest=8 
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numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

TG=ans 

response(61)=TG 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

9340  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="If  available,  does  a  current  radiograph  suggest  any  fractured 
bones?" 

option$(l,  1)=  "  1.  Yes" 
option$(2,  1)=  "  2.  No" 

option$(3, 1)= "  3.  Not  available" 

longest=17 

numops-3 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
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goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


TI=ans 

response(62)=TI 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

9450  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$=”Grasp  the  mandible  with  both  hands  using  your  thumbs  and  index 
fingers" 

ques$=ques$+"  (thumbs  on  teeth,  fingers  on  skin  adjacent  to  border  of 
mandible).” 

ques$=ques$+"  Without  using  undue  force,  gently  attempt  to  move 
different  segments  of' 

ques$=ques$+”  the  mandible." 

ques$=ques$+"  Can  bony  segments  of  the  mandible  be  displaced  or  easily 
moved?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcoI=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 
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TJ=ans 

response(63)=TJ 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

9590  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Again,  using  your  thumbs  and  index  fingers  (fingers  and  thumbs 
on" 

ques$=ques$+"  facial  and  palatal  surfaces  of  maxillary  teeth  segments), 
attempt" 

ques$=ques$+"  to  gently  displace  bony  segments  of  the  maxillary  arch." 

ques$=ques$+"  Can  bony  segments  of  the  maxilla  be  displaced  or  easily 
moved?" 

option$(l,  1)=  "  1.  Yes" 

option$(2, 1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

TK=ans 

response(64)=TK 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 
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9720  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Palpate  the  facial  bones,  including  the  zygomatic  arch  and 
infraorbital  rims." 

ques$=ques$+"  Is  there  evidence  of  a  stepping,  displacement,  or 
depression  of  the  facial" 
ques$=ques$+"  bones?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getrcsp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

TL=ans 

response(65)=TL 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

9840  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="There  is  evidence  of  bleeding" 

option$(l,  1)=  "  1.  From  abrasions  or  lacerations." 
option$(2,  1)=  "  2.  Into  tissue  spaces  (ex.  Floor  of  mouth,  vestibule, 
etc.)" 

option$(3,  1)=  "  3.  From  the  gingival  margin(s)." 
option$(4,  1)=  "  4.  #1  And  #2" 
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option$(5, 1)=  "  5.  #1  And  #3" 

option$(6,  1)=  ’’  6.  #2  And  #3" 

option$(7, 1)=  "  7.  All  of  the  above" 

option$(8, 1)= "  8.  None  of  the  above" 

longest=61 

numops=8 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


TH=ans 

response(66)=TH 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  TA=2  THEN  GOTO  1 1520 

10060  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="TraumaticalIy  involved  teeth  must  be  evaluated  individually. 

The" 

ques$=ques$+"  particular  tooth  in  question  is" 

option$(l,  1)=  "  1.  Displaced  lingually  or  facially." 
option$(2,  1)=  "  2.  Intruded  into  the  socket." 
option$(3,  1)=  "  3.  Partially  extruded  from  the  socket." 
option$(4,  1)=  "  4.  Totally  avulsed  "+chr$(34)+"knocked 
out"+chr$(34)+"." 

option$(5,  1)=  "  5.  Not  displaced." 
longest=40 
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numops=5 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

Fl=ans 

response(67)=Fl 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 

IF  (Fl=l)  OR  (FI  =2)  OR  (Fl=5)  THEN  GOTO  10520 

10230  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Have  more  than  3  hours  elapsed  from  the  time  of  injury?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
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goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


TN=ans 

re  spon  se  (68  )=TN 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

10320  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Is  the  tooth  generally  intact  (no  major  fractures,  cracks, 
chips)?" 

option$(l,  1)="  1.  Yes" 

option$(2, 1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

T0=ans 

response(69)=T0 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
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IF  (FI  =4)  THEN  GOTO  10430 
GOTO  10520 


10430  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Does  the  socket  of  the  avulsed  tooth  appear  intact?" 

option$(l,  1)= "  1.  Yes" 

option$(2, 1)= "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


TP=ans 

response(70)=TP 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

10520  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="As  related  by  the  patient  and  from  information  in  the  dental 
record, " 

ques$=ques$+"  if  available,  was  the  tooth  otherwise 
healthy?" 

option$(l,  1)="  1.  Yes" 
option$(2,  1)=  "  2.  No" 
longest=8 
numops=2 
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qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


TR=ans 

response(71)=TR 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

10620  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Has  the  injured  tooth  ever  had  endodontic  (root  canal) 
treatment?" 

option$(l,  1)="  1.  Yes" 

option$(2, 1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68 1  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
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end  if 


I 

TS=ans 

response(72)=TS 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
IF  Fl=4  THEN  GOTO  1 1520 

10720  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="The  tooth  in  question" 

option$(l,  1)=  "  1.  Is  extremely  mobile." 

option$(2,  1)=  "  2.  Is  slightly  mobile." 

option$(3, 1)=  "  3.  Has  no  increased  mobility." 

longest=31 

numops=3 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


TT=ans 

response(73)=TT 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 
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IF  TT=3  THEN  GOTO  10920 


10830  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initopdons 

ques$="Do  adjacent  teeth  move  when  the  injured  tooth  is  moved?" 

option$(l,  1)=  "  1.  Yes" 

option$(2, 1)= "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


TU=ar.s 

response(74)=TU 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

10920  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initopdons 
ques$="There  is" 

option$(l,  1)=  "  1.  Definitely  a  fracture  line,  crack,  or  part  of  the" 
option$(l,  2)=  "  tooth  missing." 

option$(2,  1)=  ”  2.  A  possible  fracture  line  or  crack  in  the  tooth." 
option$(3,  1)=  "  3.  No  evidence  of  a  fracture  line  or  crack  in  the 
tooth." 

longest=58 

numops=3 
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qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getrcsp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


TW=ans 

response(75)=TW 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  nere 
IF  TW=3  THEN  GOTO  11520 

1 1070  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 
IF  TW=2  THEN 

ques$="Does  the  possible  fracture  line  or  crack  involve  the" 
elselF  TW=1  THEN 

ques$="Does  the  fracture  line  or  crack  or  the  part  of  the  tooth  missing 
involve  the" 
end  if 

ques$=ques$+"crown  of  the  tooth?" 

11 100  option  $(1, 1)="  1.  Yes" 
option  $(2, 1)-  "  2.  No" 
longest=8 
numops=2 
qrow=2 
qcol=5 

call  priques((ques$)) 
call  prioptions 
anas=0 
call  getresp 
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if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


TV=ans 

response(7  6)=TV 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 

11190  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 
IF  TW=2  THEN 

ques$="Does  the  possible  fracture  line  or  crack  extend  below" 
elselF  TW=1  THEN 

ques$="Does  the  fracture  line,  crack,  or  area  where  the  part  is  missing 
extend  below" 
end  if 

ques$=ques$+”  the  gingival  (gum)  tissues?" 

option$(l,  1)="  1.  Yes" 

option$(2,  1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


I 
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FL=ans 

response(77)=FL 

pause!  =timer+.5 

do  while  TIMER  pause! 

loop 

REM  branch  here 

IF  ((EB=1)  OR  (TS=1))  THEN  GOTO  1 1430 

1 1310  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 
ques$="The  pulp  (nerve)" 

option$(l,  1)=  "  1.  Has  not  been  exposed." 
option$(2,  1)=  "  2.  Has  been  exposed  and  is  smaller  than  1  mm  in 
diameter." 

option$(3,  1)=  "  3.  Has  been  exposed  and  is  larger  than  1  mm  in 
diameter." 
longest=60 
numops=3 
qrow=2 
qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 


TY=ans 

response(78)=TY 

pause!=timer+.5 

do  while  TIMER  pause! 

loop 
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REM  branch  here 

IF  (TY=2)  OR  (TY=3)  THEN  GOTO  11520 

1 1430  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Is  the  dentin  exposed?" 

option$(l,  1)= "  1.  Yes" 

option$(2, 1)=  "  2.  No" 

longest=8 

numops=2 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

TZ=ans 

response(79)=TZ 

pause  !=timer+.5 

do  while  TIMER  pause! 

loop 

REM  Set  Z  array,  depending  on  responses  to  previous  questions. 


11520  IF  (Fl=4)  AND  (TN=2)  AND  (T0=1)  AND  (TP=1)  AND  (TR=1)  THEN  Z(24)=l 
IF  (Fl=4)  AND  ((TN=1)  OR  (T0=2)  OR  (TP=2)  OR  (TR  =2))  THEN  Z(25)=l 
IF  ((Fl=l)  OR  (FI  =2)  OR  (Fl=3))  AND  (TTo3)  AND  (FLol)  AND  (TR=1) 

AND  (TUol)  THEN  Z(26)=l 

IF  ((Fl=l)  OR  (FI  =2)  OR  tFl=3))  AND  ((TR=2)  OR  (FL=1)  OR  (TT=1)  OR  (TU 
=1))  THEN  Z(27)=l 

IF  (((FI  =2)  OR  (FI  =3)  OR  (FI  =5))  AND  ((TW=1)  OR  (TW=2))  AND  (TV=1)  AND 
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(TY=1)  AND  (TZ=1))  OR  ((El=l)  AND  (EE=1)  AND  (TY  =1)  AND  (TZ=1))  THEN  Z(28)  =1 
IF  (((FI  =2)  OR  (Fl=3)  OR  (Fl=5))  AND  ((TW=1)  OR  (TW=2))  AND  (TV=1)  AND 
(TY=2)  AND  (TSol))  OR  ((El=l)  AND  (EE=1)  AND  (TV=1)  AND  (TY=2)  AND  (TS<> 

1))  THEN  Z(22)=l 

IF  (((FI  =2)  OR  (FI  =3)  OR  (Fl=5))  AND  ((TW=1)  OR  (TW=2))  AND  (TV=1)  AND 
(TY=3)  AND  (TSol))  OR  ((El=l)  AND  (EE=1)  AND  (TV=1)  AND  (TY=3)  AND  (TS  o 
1))  THEN  Z(23)=l 

IF  (Flo4)  AND  (T0=2)  AND  (TWo3)  AND  (TV=1)  AND  (FL=2)  AND  (TY 
ol)  THEN  Z(29)=l 

IF  ((Fl=l)  OR  (FI  =2)  OR  (Fl=3)  OR  (Fl=5))  AND  ((TT=1)  OR  (TT=2))  AND 
(FL=1)  THEN  Z(30)=2 

IF  ((Fl=l)  OR  (FI  =2)  OR  (Fl=3))  AND  ((TS=1)  OR  (FL=1))  AND  (TW=1)  AND 
((TT=1)  OR  (TT=2))  THEN  Z(30)=l 

IF  (TU=1)  AND  (TA<>2)  THEN  Z(31)=2 

IF  (THo8)  AND  (TU=1)  AND  ((TB=1)  OR  (TB=2))  AND  (TA<>2)  AND  ((TJ 
ol)  AND  (TKol))  THEN  Z(31)=l 

IF  (PZ=1)  OR  (TJ=1)  OR  (((TB=2)  OR  (TB=3))  AND  ((TC=1)  OR  (TG=1)))  THEN 
Z(32)=2 

IF  ((TC=1)  OR  (TG=1)  OR  (TI=1)  OR  (TH=2)  OR  (TH=4)  OR  (TH=6)  OR  (TH=7)) 

AND  ((PZ=1)  OR  (TJ=1)  OR  (TB=3))  THEN  Z(32)=l 
IF  ((PZ=2)  OR  (TK=1))  THEN  Z(33)=2 

IF  (((TB=2)  OR  (TB=3))  AND  ((TK=1)  OR  (PZ=2))  AND  (((TH=2)  OR  (TH=4)  OR 
(TH=6)  OR  (TH=7))  OR  (TI=1)))  OR  ((PZ=2)  AND  (TK=1))  THEN  Z(33)=l 
IF  (C=l)  THEN  Z(35)=2 

IF  (PZ=2)  OR  (PZ=3)  OR  ((ZYoO)  AND  (ZYo8))  OR  (TL=1)  THEN  Z(34)=2 
IF  ((TL=1)  AND  (ZY<>8)  AND  (ZYoO))  OR  ((TL  =1)  AND  (PZ=3))  OR 
(ZY=7)  OR  ((((ZYo8)  AND  (ZYoO))  OR  (PZ=3))  AND  (TI  =1))  THEN  Z(34)=l 

IF  ((TZ=2)  AND  (TV=I)  AND  (TY=1))  OR  ((El=l)  AND  (EE=I)  AND  (TY=I)  AND 
(TZ=2))  THEN  Z(29)=l 

IF  (Z(32)=l  OR  Z(33)=l)  AND  Z(31)=l  THEN  Z(31)=2 
IF  (El=l)  AND  (EE=1)  AND  (FL=1)  THEN  Z(30)=l 
if  z(25)=l  or  z(25)=2  then  z(24)=0 
if  z(27)=l  or  z(27)=2  then  z(26)=0 

11810  call  getuserdx  'get  corpsman's  diagnosis 


if  realcase=l  then  ’  save  data  for  real  case 

call  wrtdat  ’  write  responses  to  file 

end  if 


REM  Display  Diagnosis 
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11 850  els 

REM  Draw  a  box  around  the  screen  and  divide  it  into  two  columns.  Onecolumnfor  prob¬ 
able  diagnoses,  and  the  other  for  possible  diagnoses. 


color  dotcolor,  bground 

call  box  (begr,  begc,  endr-2,  endc) 
locate  begr,  endc/2:print  chr$(203); 
locate  begr+1,  endc/2:print  chr$(186); 
locate  begr+2,  begc:print  chi$(204); 
forc=begc+l  to  endc- 1 
locate  begr+2,  c ‘.print  chr$(205); 
next  c 

locate  begr+2,  endc.print  chi$(185); 
locate  begr+2,  endc/2:print  chr$(206); 

for  r=begr+3  to  endr-3 

locate  r,  endc/2:print  chr$(186); 

nextr 

locate  endr-2,  endc/2:print  chr$(202); 
color  highlight,  bground 
locate  begr+1,  1  l:print  "Probable  Diagnoses"; 
locate  begr+1,  51:print  "Possible  Diagnoses”; 
color  normal,  bground 

REM  Display  instruction  line. 


locate  25,  l:color  keyline,  keyline:print  space$(80); 
locate  25,  5:color  normal,  bground:print "  F9  ";:color  keylettr, 
keyline:print  ”-  Main  Menu"; 

locate  25, 26::color  normal,  bground.print "  F10  ";:color  keylettr, 
keyline:print "-  Sub-menu"; 

locate  25, 47::color  normal,  bgroundtprint "  F7  ";:color  keylettr, 
keyline:print "-  Defmitions"; 
color  normal,  bground 

Z(0)= 1  ’  test  for  no  diagnosis 

FOR  1=1  TO  NM 
IF  Z(I)  o  0  THEN 
Z(0)=0 
end  if 
NEXT  I 
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REM  Can’t  make  a  diagnosis,  print  no  diagnosis  message. 
if  z(0)  0  then 
sound  100, 4 
color  bground,  normal 
for  rr=0  to  4 

locate  1 1+rr,  9:print  space$(59); 
nextrr 

color  resplettr,  norm  allocate  12, 10:print  "Sorry,  ";:color  bground, 
normal 

locate  14, lOrprint  dx$(0) 
color  normal,  bground 

locate  23, 5:print  "Press  RETURN  to  continue."; 

REM  Wait  for  user  to  press  a  key.  Also,  check  ifF9  or  F10  keys  were  pressed, 
call  pressret 

REM  Branch  to  appropriate  menu  if  F9  or  F10  keys  were  pressed. 
if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

REM  Display  treatment  recommendation  for  no  diagnosis. 


nodg=l 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  box  (begr,  begc,  endr-1,  endc) 
locate  24,  1  :print  space$(80); 

color  highlight,  bground:locate  2,  31:print  "Recommended  Action";  xolor 
normal,  bground 

call  printtreatmts((nodg))  ’ pass  by  value 

REM  Display  Instruction  line  for  Treatment  Recommendations. 


locate  24,  1  xolor  keyline2,  keyline2:print  space$(80); 
locate  24,  5xolor  normal,  bground:print  "  Shift  +  PrtSc  ";xolor 
keylettr2,  keyline2:print Print  Screen"; 

locate  24,  45xolor  normal,  bground:print "  Return  ";xolor  keylettr2, 
keyline2:print To  Continue"; 
color  normal,  bground 


DENTAL  Programmer's  Manual  A-90 


call  pressret 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR,  endc-1,  scrollincs,  attrib) 

call  box  (begr,  begc,  endr,  endc) 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

goto  mainmenu 
else 

REM  Print  probable  and  possible  diagnoses 
12020  FOR  J=1  TO  2 

numdg(j)=0  ’  counter  for  number  of  probable  and  possible  diagnoses 

dgrow=begr+3  ’start  printing  on  the  third  row  after  the  box 

NK=1  ’flag  to  indicate  that  there  are  no  probable  (if  j-1)  or  no 

possible  (if  j=2)  diagnoses 

IF  J=1  THEN  ’decide  what  column  to  list  diagnoses 

dgcol=probcol 
elselF  J=2  THEN 
dgcol=posscol 
end  if 
count=0 

FOR  1=0  TO  NM  ’go  through  the  list  of  diseases 
IF  Z(I)=J  THEN  'print  this  one 
dgrow=dgrow+l 
count=count+l 

REM  If  you  get  this  far  there  must  be  a  diagnosis,  so  set  flag  to  zero. 

NK=0 

dgpos(count,  j)=dgrow  'save  position  of  diagnosis  on  the  screen 
numdg(j)=numdg(j)+ 1  ’  increment  the  number  of  diagnoses 
treatnum(count,  j)=i  ’keep  track  of  treatment  number 
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color  highlight,  bground 
a$=dot$+"  "+dx$(i) 

REM  Break  up  diagnosis  string  if  it’s  too  long  and  print. 


while  len(a$)dglmt 
b=dglmt+l 

while  mid$(a$,  b,  1)  " " 

b=b-l 

wend 

locate  dgrow,  dgcol 
print  left$(a$,  b); 
a$="  "+right$(a$,  len(a$)-b) 
dgrow=dgrow+l 
wend 

locate  dgrow,  dgcol 
print  a$; 

color  normal,  bground 
end  if 
NEXT  I 

IF  NK=1  THEN 

REM  ifj=l  there  are  no  probable  diagnoses.  Ifj=2  there  are  no  possiblediagnosis. 

locate  dgrow+1,  dgcol 
color  highlight,  bground 
print "  NONE 

color  normal,  bground 
end  if 
NEXT  J 

12350  REM  choose  treatment  plan 

REM  Print  instructions  at  the  bottom  of  the  screen. 


12360  color  normal,  bground: LOCATE  23,  9:  print  "For  Treatment 
Recommendations,  position 

color  ptrcolor,  bground:print  ptr$;:color  normal,  bground 
print  "  then  press  RETURN."; 

call  getresp2  ’  subroutine  for  user  to  select  which  treatment  plan 
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if  ans=67  then 
els 

goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 

REM  Display  treatment  recommendations. 


CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  box  (begr,  begc,  endr-1,  endc) 
locate  24,  1  :print  space$(80); 

color  highlight,  bground:  locate  2,  27:PRINT  "Treatment 
Recommendations"; :color  normal,  bground 

call  printtreatmts((treatidx(treatnum(ans,  pcol))))  'pass  by  value 
treatrow=treatrow+ 1 

REM  Print  extra  treatment  text  depending  on  responses  to  certain  questions. 


IF  X=2  AND  0=1  AND  treatnum(ans,  pcol)ol  1  AND  treatnum(ans,  pcol)<>21 
THEN 

locate  treatrow,  4:color  highlight,  bground.’PRINT  "Also:";:color 
normal,  bground 

locate  treatrow,  1 1  :PRINT  "If  you  are  unable  to  identify  the  specific 
tooth  that  may  be  causing"; 
treatrow=treatrow+ 1 

locate  treatrow,  4:PRINT  "the  problem,  look  for  a  tooth  with  a  large 
restoration  or  crown.  Examine"; 
treatrow=treatrow+ 1 

locate  treatrow,  4.PRINT  "the  area  again  for  caries  or  other  etiology 
that  may  have  been  overlooked."; 
treatrow=treatrow+ 1 
end  if 

IF  (TH=1)  OR  (TH=4)  OR  (TH=5)  OR  (TH=7)  THEN 
if  treatnum(ans,  pcol)=14  then 
treatrow=treatrow- 1 
end  if 

color  highlight,  bground 

locate  treatrow,  4:PRINT  "Also:";:color  normal,  bground 
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locate  treatrow,  1  l:print  "Update  tetanus  vaccine  as  needed.  If  a 
laceration  is  on  the  lip, 

treatrow=treatrow+ 1 

locate  treatrow,  4:PRINT  "align  the  vermillion  border  first.  Evert 
the  edges  of  the  tissue.  Use  5-0"; 
treatrow=treatrow+ 1 

locate  treatrow,  4:PRINT  "or  6-0  nylon  sutures  on  skin."; 
end  if 

IF  ((El=l)  OR  (E6=l))  AND  (EB=1)  THEN 
locate  treatrow,  4:color  highlight,  bgrount:print"Also:";:color 
normal,  bground 

PRINT  "  A  root  canal  and  sensitivity  to  hot  or  cold  are 
inconsistent.  Check"; 

treatrow=treatrow+ 1 

locate  treatrow,  4:PRINT  "adjacent  teeth.  There  may  be  a  partially 
completed  root  canal  present."; 
end  if 

locate  24, 1  :color  keyline2,  keyline2:print  space$(80); 
locate  24,  5:color  normal,  bgroundrprint "  Shift  +  PrtSc  ";:color 
keylettr2,  keyline2:print "-  Print  Screen"; 

locate  24, 45:color  normal,  bground:print "  Return  ";:color  keylettr2, 
keyline2:print "-  To  Continue"; 
color  normal,  bground 
call  pressret 

if  ans=67  then 
goto  mainmenu 
elseif  ans=681  then 
goto  nottrauma 
elseif  ans=682  then 
goto  trauma 
end  if 
end  if 

’go  back  to  print  diagnoses 
goto  1 1 850 

REM  The  following  data  statements  contain  the  data  for  the  TREATIDX  andThe  DX$ 
arrays. 

DATA  1,  A  diagnosis  cannot  be  made  from  the  information  available. 

DATA  1 1 .  Localized  Alveolar  Osteitis  (Dry  Socket) 

DATA  20,  Osseous  Sequestrum 
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DATA  30,  Abscess/Infection/Cellulitis 

DATA  42,  Periodontal  Abscess 

DATA  53,  Reversible  Pulpitis 

DATA  64,  Irreversible  Pulpitis 

DATA  75,  Acute  Apical  Abscess 

DATA  87,  Acute  Apical  Periodontitis 

DATA  99,  Carious  Lesion  (Decay) 

DATA  113,  Dentin  Hypersensitivity 

DATA  124,  Maxillary  Sinusitis 

DATA  136,  Endodontic/Periodontic  Combined  Problem 

DATA  148,  Defective  Restoration 

DATA  159,  Acute  Herpetic  Gingivostomatitis 

DATA  176,  Pericoronitis/Erupting  Tooth 

DATA  190,  Necrotizing  Ulcerative  Gingivitis 

DATA  203,  Acute  Gingivitis 

DATA  213,  Food  Impaction 

DATA  224,  Myofascial  Pain/Muscle  Spasms 

DATA  235,  Internal  Derangement  of  the  Temporomandibular  Joint 

DATA  247,  Occlusal  Trauma 

DATA  259,  "Fractured  Crown,  Small  Pulp  Exposure" 

DATA  271,  "Fractured  Crown,  Large  Pulp  Exposure" 

DATA  283,  "Total  Avulsion  of  Tooth,  Good  Candidate  for  Replantation" 
DATA  298,  "Total  Avulsion  of  Tooth,  Poor  Candidate  for  Replantation" 
DATA  310,  "Displacement/Mobility  of  Tooth,  Favorable  Prognosis" 
DATA  321 ,  "Displacement/Mobility  of  Tooth,  Guarded  Prognosis" 
DATA  331,  "Fractured  Crown,  Pulp  Not  Exposed" 

DATA  343,  Enamel  Fracture 

DATA  352,  Root  Fracture 

DATA  363,  Fractured  Alveolar  Bone 

DATA  373,  Fractured  Mandible 

DATA  384,  Fractured  Maxilla 

DATA  396,  Fractured  Facial  Bones 

DATA  407,  Neurologic  Injury 


end 


REM  Display  end  page. 


15230  CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
locate  5,  10.PRINT  "Thank  you.  If  you  have  any  questions  concerning 
this  program, " 

locate  6,  10:PRINT  "please  contact:" 
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locate  9, 10:PRINT  "Commanding  Officer" 

locate  10,  10:PRINT  "Naval  Submarine  Medical  Research  Laboratory" 
locate  11,  10:PRINT  "Naval  Submarine  Base  New  London" 
locate  12,  10:PRINT  "Groton,  Connecticut  06349-5900" 
locate  14,  10:PRINT  "(203)  449-2523  commercial" 
locate  15,  10:PRINT "  8-241-2523  autovon" 

locate  23,  1,  1  ’turn  cursor  back  on 

close  ’close  all  open  files 

END 

REM  Subroutine  to  initialize  all  answer  variables. 


32400  RESTORE:X=0:XX=0:TA=0:CI=0:G=0:LT=0:UZ=0:RX=0:PL=0:PV=0 
PZ=0:ZY=0:NK=0 

GX=0:D1=0:D2=0:D3=0:TM=0:DU=0:PN  =0:PB=0:PC=0:PE=0 

E 1  =0:E2=0:E3=0:E4=0:E5=0:E6=0:E7=0:E8=0:E9=0:EB=0:EC=0:EE=0 

E1=0:EG=0:EH=0:ZZ=0:EA=0:XX=  0:PQ=0:P1=0:P2=0:P3=0:P4=0:P5=0 

P6=0:P7=0:P8=0:P9=0:PG=0:PH=0:PF=0:TQ=0:X1=0:X2=0:X3=0:X4=0 

X5=0:X6=0:X7=0:X8=0:X9=0:TF=0:OW=0:SA=0:SB=0:SC=0:G=0:SZ=0:MW=0 

MR=0:MB=0:MY=0:MP=0:SH=0:SI=0:SJ=0:SK=0:TB=0:TC=0:TG=0 

TI=0:TJ=0:TK=0:TL=0:TH=0:F1=0:TN=0:TO=0:TP=0:TR=0:TS=0:TT=0:TU=0 

TW=0:TV=0:FL=0:TY=0:TZ=0:C=0:J=0:NF=0:NT=0:LZ=0:domenu=0:GX=0 

ERASE  response,  z 

RETURN 

Subroutine  SEETRTMTS 
called  from:  DENTAL  ( Main  Menu ) 
calls:  SCROLLUP,  BOX,  PRINTTREATMTS,  PRESSRET 
Display  Treatment  Recommendations  Menu ,  allow  user  to  select  a  diagnosis, 
then  display  corresponding  treatment  plan. 

sub  seetrtmts  static 

shared  DX$(),  NM,  dot$,  begr,  begc,  endr,  endc,  scrollines,  attrib 
shared  highlight,  tdline(),  treatnum(),  treatidx(),  tptrcol 
shared 

ans2,  page,  firstdg,  lastdg,  keylettr,  keyline,  keylettr2,  keyline2 

tptrcol =7  :dgcol= 1 0 
main =67 
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dglmt=70 

ans2=0 

locate  begr+1, 24 
color  quescolor,  bground 
print  "Treatment  Recommentations  Menu"; 
color  normal,  bground 

locate  25,  l:color  keyline,  keyline:print  space$(80); 
locate  25,  3:color  normal,  bgroundrprint "  F9  ";:color  keylettr, 
keyline:print Main  Menu"; 

locate  25, 21  rcolor  normal,  bg:ound:print "  F7  ";:color  keylettr, 
keyline:print "-  DeFmitions"; 

locate  25, 40:color  normal,  bground:print "  PgDn  ";:color  keylettr, 
keyline:print Next  Page"; 

locate  25,  58:color  normal,  bground:print  "  PgUp  ";:color  keylettr, 
keylinerprint Previous  Page"; 

page=l 

while  ans2  <>  main  ’do  until  user  hits  F9  key 
ans2=0 

dgrow=begr+2 

IF  page=l  THEN  ’dx's  1-18  are  on  first  page 
firstdg=l 
lastdg=18 

elselF  page=2  THEN  ’dx’s  19-35  are  on  second  page 
firstdg=19 
lastdg=NM 
end  if 
count=0 

REM  List  the  diagnoses  for  this  page. 


FOR  I  =firstdg  TO  lastdg 
dgrow=dgrow+l 
count=count+l 
tdline(count)=dgrow 
color  highlight,  bground 
a$=dot$+"  "+dx$(i) 
while  len(a$)dglmt 
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b=dglmt+l 

while  mid$(a$,  b,  1 )  <> 
b=b-l 
wend 

locate  dgrow,  dgcol 
print  left$(a$,  b); 
a$="  "+right$(a$,  len(a$)-b) 
dgrow=dgrow+l 
wend 

locate  dgrow,  dgcol 
print  a$; 

color  normal,  bground 
NEXT  I 

locate  23, 65:print"(Page  ”;right$(str$(page),  1);"  of 

2)"; 

color  normal,  bground 

REM  choose  treatment  plan 
call  trtresp 

REM  print  treatment  plan 
if  ans2>=  firstdg  and  ans2<=Jastdg=then_ 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 

color  highlight,  bgroundrlocate  2, 27:PRINT  "Treatment 
Recommendations";:color  normal,  bground 

locate  25,  l:color  keyline2,  keyline2:print  space$(80); 

locate  25,  5:color  normal,  bground:print "  Shift  +  PrtSc  ";:color 
keylettr2,  keyline2:print Print  Screen"; 

locate  25,  37:color  normal,  bground:print "  Return  ";:color 
keylettr2,  keyline2:print To  Continue"; 

locate  25,  61  :color  normal,  bground:print "  F7  ";:color  keylettr2, 
keyline2:print Definitions"; 

color  normal,  bground 

call  printtreatmts((treatidx(ans2)))  'pass  by  value 

call  pressret 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 

call  box(begr,  begc,  endr,  endc) 
end  if 


DENTAL  Programmer’ s  Manual  A-98 


if  ans2  o  main  then 

locate  25, 1 -.color  keyline,  keyline:print  space$(80); 
locate  25,  3  .color  normal,  bgrcundrpnnt "  F9  ";:coIo«  keylettr, 
keylinerprint Main  Menu"; 

locate  25,  21  rcolor  normal,  bground:print "  F7  ";:color  keylettr, 
keyline:print Definitions"; 

locate  25, 40:color  normal,  bgroundrprint "  PgDn  ";;color  keylettr, 
keylinerprint Next  Page"; 

locate  25, 58:color  normal,  bgroundrprint "  PgUp  ";:color  keylettr, 
keylinerprint Previous  Page"; 
end  if 

locate  begr+1,  24 
color  quescolor,  bground 
print  "Treatment  Recommentations  Menu"; 
color  normal,  bground 
wend 
end  sub 

Subroutine  PRINTTREATMTS 

called  from:  DENTAL,  SEETRTMTS 

This  routine  opens  the  treatment  recommendations  file 

(TREATS. RND)  and  prints  selected  treatment  plan. 

sub  printtreatmts  (yu)  static 
shared  treatrow 

REM  open  random  file  for  treatments 
OPEN  "R",  #5,  "trtmts.md",  75 

FIELD  #5,  75  AS  A$ 

REM  treatment  #14 
if  yu=162  then 
treatrow=2 
else 

treatrow=3 
end  if 

while  instr(a$,  T)=0 
GET  #5,  YU 
yu=yu+l 

trcatrow=treatrow+ 1 
ifinstr(a$,  T')=0  then 

locate  treatrow,  4:PRINT  a$; 
end  if 
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wend 

CLOSE  #5 
end  sub 

Subroutine  TRTRESP 
called  from:  SEETRTMTS 
calls:  SCROLLUP 

This  routine  waits  for  a  response  to  the  Treatment 
Recommendations  Menu.  The  user  can  press  the  up  and  down  arrow 
keys  to  highlight  a  diagnosis,  press  return  to  select  it,  press 
page  up  and  page  down  to  view  the  two  pages  of  diagnoses,  press 
F9  to  go  back  to  the  main  menu,  or  press  F7  to  see  the  Term 
Definitions. 

sub  trtresp  static 

shared  ans2,  page,  tdline(),  firstdg,  lastdg,  tptrcol 
shared  dgcol,  begr,  begc,  endr,  endc,  scrollines,  attrib 

count=l 

locate  tdline(count),  tptrcol  ’put  pointer  at  first  probable  or  possible  diagnosis 

color  ptrcolor,  bgroundrprint  ptr$; 
color  normal,  bground 

numdg=lastdg-firstdg+ 1 

startpage=page 

while  ans2=0  and  page=startpage 

DO  UNTIL  z$=""  ’  clear  keyboard  buffer 

z$=inkey$ 

LOOP 

DO  ’  now  get  response 

z$=inkey$ 

LOOP  WHILE  z$="" 

if  z$=chr$(13)  then 
ans2=firstdg+count- 1 
elseif  len(z$)=2  then 
z$=right$(z$,  1) 
if  z$=chr$(72)  then  ’***  up 

REM  print  blanks  where  old  ptr  is 
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locate  tdline(count),  tptrcolrprint  blanks2$; 
count=count-l:  if  count  lthencount=l 
color  ptrcolor,  bground 
locate  tdline(count),  tptrcol:print  ptr$; 
color  normal,  bground 
elseif  z$=chr$(80)  then  ’***  down 
REM  print  blanks  where  old  ptr  is 
locate  tdline(count),  tptrcol:print  blanks2$; 
count=count+l:if  count  >  numdg  then  count=numdg 
color  ptrcolor,  bground 
locate  tdline(count),  tptrcol  .print  ptr$; 
color  normal,  bground 
elseif  z$=chr$(67)  then  ’***  F9  main  menu 
ans2=67 

elseif  z$=chr$(65)  then  ’***  F7  term  definitions 
call  definitionroutine2 
count=l 

elseif  z$=chr$(73)  then  ’***  pgup 
if  page=2  then 

CALL  SCROLLUP  (BEGR+2,  BEGC+1,  ENDR-2,  endc-1,  scrollines,  attrib) 

page=l 
end  if 

elseif  z$=chr$(81)  then  ’***  pgdn 
if  page=l  then 

CALL  SCROLLUP  (BEGR+2,  BEGC+1,  ENDR-2,  endc-1,  scrollines,  attrib) 

page=2 
end  if 
end  if 
end  if 
wend 
end  sub 

Subroutine  PRESSRET 

called  from:  DENTAL,  SEETRTMTS 

This  routine  is  called  after  displaying  "Press  RETURN  to 

continue"  on  the  screen.  Along  with  the  return  key,  it  also 

allows  the  user  to  press  F9  for  the  Main  Menu,  F10  for  a  Sub- 

Menu,  p  for  the  Term  Definitions  and  PgDn  to  view  the  next  page 

of  a  treatment  plan. 

sub  pressret  static 

shared  page,  npages,  keyline2,  keylettr2 
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ans=0 

while  ans=0 

getkeyl:  ’  clear  keyboard  buffer 

z$=inkey$ 

if  z$  o  ""  then 

goto  getkeyl 

end  if 

getkey2: 

z$=inikey$ 

if  2$=’’"  then 

goto  getkey2 

end  if 

if  z$=chr$(13)  then 
ans=13 

elseif  len(z$)=2  then 
z$=right$(z$,  1) 

if  z$=chr$(67)  and  mmenu  o  5  then  ’***  F9  main  menu 
ans=67 

elseif  z$=chr$(68)  and  mmenu  <>  0  and  mmenu  <>  5  then  ’***  F10  sub  menu 
if  mmenu=l  then 
ans=681 

elseif  mmenu=2  then 
ans=682 
end  if 

elseif  z$=chr$(65)  then  ’***  F7  definitions 
call  definitionroutine2 
elseif  z$=chr$(8 1 )  then  ’  ***  PgDn 
ans=81 
end  if 
end  if 
wend 
end  sub 

Subroutine  GETRESP2 

called  from:  DENTAL  ( diagnosis  section ) 

This  routine  allows  the  user  to  choose  a  treatment  plan  to  view 
from  the  list  of  probable  and  possible  diagnoses.  To  select  a 
diagnosis  the  user  highlights  it  by  pressing  one  of  the  direction 
keys,  then  RETURN  to  select  it.  He  can  also  press  F9  to  go  back 
to  the  Main  Menu,  F10  to  go  to  a  Sub-menu,  and  F7  to  see  the  Term 
Definitions. 

sub  getresp2  static 
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shared  ans,  dgpos(),  numdgO 

shared  ptrcol,  ptr$,  ptrcolor,  blanks2$,  respbar,  resplettr 
shared  normal,  bground,  probptr,  possptr,  pcol,  mmenu 

count=  1 

ifnumdg(l)  Othen 
pcol=l 

ptrcol=probptr 

else 

pcol=2 

ptrcol=possptr 
end  if 

locate  dgpos(count,  pcol),  ptrcol  'put  pointer  at  first  probable  or  possible  diagnosis 

color  ptrcolor,  bground.print  ptr$; 
color  normal,  bground 

ans=0 

while  ans=0 

getkey3:  ’  clear  keyboard  buffer 

z$=inlkey$ 

if  z$  o  ""  then 

goto  getkey3 

end  if 

getkey4:  ’ now  get  response 

z$=inkey$ 

if  z$=’"’  then 

goto  getkey4 

end  if 

if  z$=chr$(13)  then 
ans=count 

elseif  len(z$)=2  then 
z$=right$(z$,  1) 
if  z$=chr$(72)  then  ’***  up 
REM  print  blanks  where  old  ptr  is 
locate  dgpos(count,  pcol),  ptrcol:print  blanks2$; 
count=count-l:if  count  <  1  then  count=l 
color  ptrcolor,  bground 
locate  dgpos(count,  pcol),  ptrcobprint  ptr$; 
color  normal,  bground 
elseif  z$=chr$(80)  then  ’***  down 
REM  print  blanks  where  old  ptr  is 
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locate  dgpos(count,  pcol),  ptrcol:print  blanks2$; 
count=count+l:if  count  >  numdg(pcol)  then 
count=numdg(pcol) 

color  ptrcolor,  bground 

locate  dgpos(count,  pcol),  ptrcolrprint  pti$; 

color  normal,  bground 

elseif  z$=chr$(75)  and  numdg(l)  <>  0  then  ’***  left 
locate  dgpos(count,  pcol),  ptrcol:  print  blanks2$; 
if  pcol=2  then 
pcol=l 
count=l 
ptrcol=probptr 
end  if 

color  ptrcolor,  bground 

locate  dgpos(count,  pcol),  ptrcolrprint  ptr$; 

color  normal,  bground 

elseif  z$=chr$(77)  and  numdg(2)  <>  0  then  '***  right 
locate  dgpos(count,  pcol),  ptrcolrprint  blanks2$; 
if  pcol=l  then 
pcol =2 


count=l 
ptrcol=possptr 
end  if 

color  ptrcolor,  bground 

locate  dgpos(count,  pcol),  ptrcolrprint  ptr$; 

color  normal,  bground 

elseif  z$=chr$(67)  and  mmenu  <>  0  then  ’***  F9  main  menu 
ans=67 

elseif  z$=chr$(68)  and  mmenu  <>  0  then  ’***  F10  sub  menu 
if  mmenu=l  then 
ans=681 

elseif  mmenu=2  then 
ans=682 
end  if 

elseif  z$=chr$(65)  then  ’***  definitions 

call  definitionroutine2 
end  if 
end  if 
wend 
end  sub 


Subroutine  GETUSERDX 
called  from:  DENTAL 
calls:  DXRESP,  SCROLLUP 
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The  purpose  of  this  routine  is  to  get  the  Corpsman’s  diagnosis. 
sub  getuserdx  static 

shared  DX$(),  NM,  dot$,  begr,  begc,  endr,  endc,  scrollines,  attrib 
shared  highlight,  tdlineO,  dotcolor,  ans3,  page,  firstdg,  lastdg 
shared  keylettr,  keyline,  selectdot$,  tptrcol 

tptrcol=7  :dgcol=  1 0 
esc=270 
ans3=0 
erase  corpresp 

call  SCROLLUP  (begr+1,  begc+1,  endr-1,  endc-1,  scrollines,  attrib) 
color  quescolor,  bground 
locate  begr+1,  30 
print  "Corpsman’s  Diagnosis"; 
locate  begr+3,  22 

print  "Select  the  Most  Likely  Diagnosis(es)"; 
color  normal,  bground 

locate  25,  lrcolor  keyline,  keylinerprint  space$(80); 
locate  25,  2:color  normal,  bgroundrprint  ”  Esc  ";:color  keylettr, 
keyline:print Exit  this  Menu"; 

locate  25,  24:color  normal,  bgroundrprint "  F7  ";:color  keylettr, 
keylinerprint Definitions”; 

locate  25,  42:color  normal,  bgroundrprint  "  PgDn  ";:color  keylettr, 
keylinerprint "-  Next  Page"; 

locate  25, 60:color  normal,  bgroundrprint "  PgUp  ";:color  keylettr, 
keylinerprint "-  Previous  Page"; 

page=l 

while  ans3  <>  esc 

call  SCROLLUP  (begr +4,  begc+1,  endr-1,  endc-1,  scrollines,  attrib) 
ans3=0 

dgrow=begr+4 

IF  page=l  THEN 
firstdg=l 
lastdg=18 

elselF  page=2  THEN 
firstdg=19 
lastdg=NM+l 
end  if 
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count=0 

FOR  I  =fxrstdg  TO  lastdg 
dgrow=dgrow+ 1 
count=count+l 
tdline(count)=dgrow 
if  corpresp(i)=l  then 
dcolor=dotcolor 
whatdot$=selectdot$ 
else 

dcolor=highlight 
whatdot$=dot$ 
end  if 

locate  dgrow,  dgcol 
color  dcolor,  bground 
print  whatdot$; 
if  I=nm+1  then 
print  ”  ";"Other”; 
else 

print "  "+dx$(i); 
end  if 

color  normal,  bground 
NEXT  I 

locate  23,  65:print"(Page  ”;right$(str$(page),  1);"  of 

2)"; 

color  normal,  bground 

REM  get  corp smart’ s  response 
call  dxresp 
wend 

color  normal,  bground 
end  sub 

Subroutine  DXRESP 

called  from:  GETUSERDX 

calls:  ENTEROTHER,  SCROLLUP 

Allow  the  user  to  select  one  or  more  diagnoses.  If  he  selects 

"Other",  then  call  ENTEROTHER. 

sub  dxresp  static 

shared  ans3,  page,  tdline(),  firstdg,  lastdg,  tptrcol,  dot$,  dotcolor,  NM 

shared  dgcol,  begr,  begc,  endr,  endc,  scrollines,  attrib,  dx$(),  highlight 
shared  selectdot$,  other$,  otherfram 
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esc=270 

count=l 


locate  tdline(count),  tptrcol  ’put  pointer  at  first  probable  or  possible  diagnosis 

color  ptrcolor,  bgroundrprint  ptr$; 
color  normal,  bground 

numdg=lastdg-firstdg+ 1 
dotcol=tptrcol+3 

startpage=page 

while  ans3oesc  and  page=startpage 
DO  UNTIL  z$=""  ’  clear  keyboard  buffer 

z$=inkey$ 

LOOP 

DO  ’  now  get  response 

z$=inkey$ 

LOOP  WHILE  z$="" 


if  z$=chr$(13)  then 
ans3=firstdg+count- 1 
if  corpresp(firstdg+count-l)=0  then 
corpresp(firstdg+count- 1  )= 1 
locate  tdline(count),  dotcol 
color  dotcolor,  bground 
print  selectdot$;" 
if  firstdg+count-l=NM+l  then 
print  "Other"; 
call  enterother 
else 

prim  dx$(firstdg+count- 1 ); 
end  if 
else 

corpresp(firstdg+count- 1  )=0 
locate  tdline(count),  dotcol 
color  highlight,  bground 
print  dot$;"  "; 

if  firstdg+count-l=NM+l  then 
print  "Other"; 
other$="" 
else 

print  dx$(firstdg+count-l); 
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end  if 
end  if 

elseif  z$=chr$(27)  then  ’***  Esc 

’Check  if  corpsman  selected  a  dx.  If  not,  ignore  Esc  key. 
for  x=l  to  36 

if  corpresp(x)=l  then 
ans3=270 
exit  for 
end  if 
next  x 

if  ans3270  then  ’corpsman  hasn’t  selected  a  dx. 

call  pushwindow(abs(otherfram),  otherfram, 15,  18,  3, 43) 
call  wlocate  (1,2) 

call  fprint(”You  must  select  at  least  one  diagnosis.",  abs(otherfram)) 
beep 

pause  !=timer+l 
do  while  timer  pause! 
loop 

call  removewindow 
end  if 

elseif  len(z$)=2  then 
z$=right$(z$,  1) 
if  z$=chr$(72)  then  ’***  up 
REM  print  blanks  where  old  ptr  is 

locate  tdline(count),  tptrcol.print  blanks2$; 
count=count-l:if  count  1  thencount=l 
color  ptrcolor,  bground 
locate  tdline(count),  tptrcohprint  ptr$; 
color  normal,  bground 
elseif  z$=chr$(80)  then  '***  down 
REM  print  blanks  where  old  ptr  is 

locate  tdline(count),  tptrcohprint  blanks2$; 
count=count+l:if  count  numdg  then  count=numdg 
color  ptrcolor,  bground 
locate  tdline(count),  tptrcohprint  ptr$; 
color  normal,  bground 
elseif  z$=chr$(65)  then  ’***  F7  definitions 
call  definitionroutine2 
count=l 

elseif  z$=chr$(73)  then  '***  pgup 
if  page=2  then 

CALL  SCROLLUP  (BEGR+4,  BEGC+1,  ENDR-2,  endc-1,  scrollines,  attrib) 
page=l 
end  if 


DENTAL  Programmer’ s  Manual  A- 108 


elseif  z$=chr$(81)  then  ’***  pgdn 
if  page=l  then 

CALL  SCROLLUP  (BEGR+4,  BEGC+1,  ENDR-2,  endc-1,  scrollines,  attrib) 
page=2 
end  if 
end  if 
end  if 
wend 
end  sub 

Subroutine  ENTEROTHER 

called  from:  DXRESP 

calls:  FPRINT,  PUSHWINDOW 

Display  a  window  on  the  screen  next  to  "other"  and  allow  the  user 
to  enter  up  to  40  characters  of  text. 

sub  enterother  static 

shared  other$,  otherscm,  otherfram 

call  pushwindow(otherscm,  otherfram,  "Enter  Your 

Diagnosis",  21,  30,  3,  46) 

other$="" 

otherptr=0  ' string  pointer 

LOCATE  22,  33  +  otherptr,  1 
DO 
DO 

a$=INKEY$ 

LOOP  WHILE  a$="" 

SELECT  CASE  ASC(LEFT$(a$,  1)) 

CASE  32,  48  TO  57,  65  TO  90,  97  to  122  ’ alphanumeric s  and  blank 

other$=other$  +  a$ 
otherptr=otherptr  +  1 
if  otherptr  >  40  then 
otherptr=40 
beep 
else 

LOCATE  22,  32  +  otherptr 
CALL  fprint(a$,  otherscm) 

LOCATE  22,  33  +  otherptr,  1 
end  if 

CASE  8  ’backspace! delete 

otherptr=otherptr  -  1 
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DF  otherptr  <  0  THEN  otherptr=0 
LOCATE  22,  33  +  otherptr,  1 
CALL  fprint("  ",  otherscm) 
other$=LEFT$(other$,  otherptr) 

CASE  13  ’CR  to  accept 

call  removewindow 
CASE  ELSE 
BEEP 

END  SELECT 
LOOP  UNTIL  a$=chr$(13) 
LOCATE  , ,  0 
end  sub 
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Appendix  A 
Program  Listings 


DIFF.BAS 

REM  This  program  contains  the  Soft  Tissue  Lesions  section  of  the  Dental 
pain  program.  Control  is  passed  to  it  from  the  main  program  (DENTAL) 
when  the  user  selects  "A  Clinical  Change  in  Oral/Facial  Tissues"  (#3) 
from  the  Main  Menu. 

REM  This  program  was  modified  last  on  2/13/89  by  Cindy  Burgess-Russotti. 
DEFINT  A-Z 

REM  Arrays  for  DENTAL  and  DIFF 

dim  option$(10,  2),  opline(lO) 
dim  z(35),  response(92),  corpresp(36) 

REM  Arrays  for  window  routines. 

DIM  WINDscratt(5),  WINDframatt(5),  WINDheader$(5) 

DIM  WENDrow(5),  WINDcol(5),  WINDheight(5),  WINDwidth(5) 

DIM  wind%(2000, 5) 

DIM  WINDrowptr(5),  WINDcolptr(5)  ’  UL  corner  of  frame 

REM  Arrays  for  definition  routines. 

DIM  item$(120),  dindx(120,  2),  disease$(34),  disindx(34, 2) 

REM  Include  common  statements  for  all  modules. 

rem  $include:  ’dentcomm.bas’ 
rem  Sinclude:  ’windcomm.bas’ 


wherefrom$="diff '  ’ Set  flag  to  show  DIFF  has  been  executed. 
ptr$=chr$(  1 6)+chr$(  1 6)  ’  Pointer  character 
blanks2$="  " 
col=0 

begr=l:begc=l  :endr=24:endc=80:scrollines=0:attrib=0 
REM  Initialize  variables  for  color  or  momochrome. 
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if  mon$="m"  ormon$="M"  then 

blink=  1 6:highlight=  1 5  :normal=7  :bground=0:border=0:quescolor=  1 5 
keyline=7  :keylettr=0:ptrcolor=  1 5:respbar=7  :resplettr=0:astrsk=  1 5 
keyline2=  1 5  :keylettr2=0 

REM  definition  routine  colors 

defkey  line=7  :defkeylettr=0:def  1  f=- 1 1 2:def  1  s=7 
def2f=-l  12:def2s=7:selectlf=-l  12:select2f=-l  12:select2s=7 
else 

blink= 1 6:highlight=  1 4:normal=7  :bground=0:  border=0:quescolor=  1 5 
keyline=  1  :key  lettr=7  :ptrcolor=  1 2  :respbar=7  :resplettr=  1 :  astrsk= 1 4 
keyline2=3  :keylettr2=  1 

REM  definition  routine  colors 

defkey  line=3:defkeylettr=0:def  1  f=- 1 1 6:def  1  s=48 
def2f=-32:def2s=l  13:selectlf=-23:select2f=-l  16:select2s=48 
end  if 

REM  Print  instructions  page. 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 

COLOR  highlight,  bground 

locate  2,  26:PRINT  "Soft  Tissue  Lesions  Section" 

color  normal,  bground 

color  highlight,  bground 

locate  5,  34:PRINT  "Instructions" 

color  normal,  bground 

locate  7,  3:PRINT  "Definitive  diagnosis  of  a  soft  tissue  lesion  usually 
cannot  be  made  without” 

locate  8,  3:PRINT  "microscopic  examination  of  biopsied  tissue." 
locate  10,  3:PRINT  "This  section  of  the  program  will  present  a 
differential  diagnosis  for  various 

locate  11,  3:PRINT  "soft  tissue  lesions." 

locate  13,  3:PRINT  "Diagnoses  in  the  differential  list  that  have  an 
asterisk  ("; 

color  astrsk,  bground:print 

color  normal,  bgroundtprint ")  beside  them" 

locate  14,  3:PRINT  "should  be  investigated  as  possible  life-threatening 
or  mission-threatening" 

locate  15,  3:PRINT  "situations.  This  does  not  imply  that  the  other 
possible  diagnoses  will  not" 

locate  16,  3:PRINT  "or  cannot  lead  to  a  mission-threatening  situation. 
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All  situations  should  be" 

locate  17,  3:print  "followed-up!" 

locate  19,  3:PRINT  "Please  carefully  select  the  primary  area  of  concern 
on  the  soft  tissue" 

locate  20, 3:PRINT  "lesions  menu.  When  indicated,  press  Function  key  9 
(F9)  or  10  (F10)" 

locate  21,  3:PRINT  "to  go  to  the  Main  Menu  or  the  Soft  Tissue  Lesions 
Menu,  respectively." 

LOCATE  25,  1  :print  "Press  RETURN  to  continue."; 
x$=input$(l) 

REM  Clear  screen,  draw  box,  and  display  Soft  Tissue  Lesions  Menu. 
softmenu: 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  box  (begr,  begc,  endr,  endc) 
call  initoptions 
color  highlight,  bground 
locate  2, 28:print  "Soft  Tissue  Lesions  Menu" 
color  normal,  bground 
option$(l,  1)= "  1.  Gingival  Changes" 
option$(2,  1)= "  2.  Tissue  Color  Changes" 
option$(3,  1)=  "  3.  Vesicles,  Bullae,  or  Ulcers” 
option$(4, 1)=  "  4.  Oral  Nodules  or  Enlargements" 
option$(5,  1)= "  5.  Tongue  (Pain,  Morphologic  Changes)" 
option$(6, 1)=  "  6.  Neck/Face/Cheek  Masses" 
option$(7, 1)=  "  7.  Quit" 

REM  Initialize  variables. 

SA=0:SB=0:SC=0:SZ=0:MW=0:MB=0:MY=0:MP=0 

MR=0:SH=0:SI=0:SJ=0:SK=0:P=0 

tempresponre=response(  1 )  ’save  response(  1 ),  response  for  main  menu 

erase  response  ’before  erasing  response  array 

response(  1  )=tempresponse 

longest=39 

numops=7 

call  prioptions 

oprow=oprow-(numops*2) 

locate  20,  5:color  highlight,  bgroundrprint  "Note: 


DENTAL  Programmer’ s  Manual  A- 113 


locate  21, 7:color  normal,  bgroundrprint  "Use  No.  2  above  for  gingival  color 
changes.  For  primary  complaints" 

locate  22, 7:PRINT  "of  gingival  inflammation  or  pain,  use  the  Main  Menu 
first." 

REM  Display  instruction  line  at  bottom  of  screen. 

locate  25,  lrcolor  keyline,  keylinerprint  space$(80); 
locate  25,  5:color  normal,  bgroundrprint "  F9  ";:color  keylettr, 
keylinerprint "  Main  Menu"; 

locate  25, 59:color  normal,  bgroundrprint "  F7  ";:color  keylettr, 
keylinerprint "  Definitions"; 
color  normal,  bground 

ans=0 

call  getresp  ’Get  user’ s  response. 

softmenu=ans 

SA=ans 

response(80)=SA 
if  ans=67  then 

goto  mainmenu  'If  user  pressed  the  "F9"  key  go  back  to  the  Main  Menu  in 
the  main  program  (DENTAL), 
end  if 

pause!=timer+.5 

do  while  TIMER  <  pause! 

loop 


locate  25,  lrcolor  keyline,  keylinerprint  space$(80); 
locate  25,  5:color  normal,  bgroundrprint "  F9  ";:color  keylettr, 
keylinerprint "  Main  Menu"; 

locate  25, 26:color  normal,  bgroundrprint "  F10  ";:color  keylettr, 

keylinerprint "  Soft  Tissue  Lesions  Menu"; 

locate  25,  59:color  normal,  bgroundrprint  "  F7  ";:color  keylettr, 

keylinerprint "  Definitions"; 

color  normal,  bground 

REM  branch  according  to  user’s  response 

IF  SA  =  1  THEN  GOTO  20690 
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IF  SA  =  2  THEN  GOTO  20970 
)  IF  SA  =  3  THEN  GOTO  21730 

IF  SA  =  4  THEN  GOTO  21870 
IF  SA  =  5  THEN  GOTO  22010 
IF  SA  =  6  THEN  GOTO  22160 
IF  SA  =  7  THEN  GOTOendit 


20690  call  scrollup  (begr+1,  begc+1,  endr-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="What  is  the  nature  of  the  gingival  problem?" 

option$(l,  1)="  1.  Desquamation" 

option$(2, 1)="  2.  Atrophy  or  ulceration" 

option$(3, 1)="  3.  Localized  hyperplastic,  hemorrhagic  lesions" 

option$(4,  1)="  4.  Generalized  hyperplastic,  hemorrhagic  lesions" 

option$(5, 1)="  5.  Localized  hyperplastic,  non-hemorrhagic  lesions" 

option$(6, 1)="  6.  Generalized  hyperplastic,  hemorrhagic  lesions" 

option$(7,  1)="  7.  Cystic  lesions" 

option$(8,  1)="  8.  None  of  the  above" 

longest=52 
numops=8 
qrow=2 
I  qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

SB=ans 

response(81)=SB 

pause!  =timer+.5 

do  while  TIMER  <  pause! 

loop 


IF  SB  =  8  THEN  GOTO  softmenu 

IF  (SB  =  1)  OR  (SB  *  2)  OR  (SB  =  3)  OR  (SB  =  4)  OR  (SB  =5)  OR  (SB  =  6) 
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OR  (SB  =  7)  THEN  GOTO  printdg 


20840  call  scrollup  (begr+1,  begc+1,  endr-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="What  is  the  nature  of  the  mucosal  problem?" 
option$(l,  1)="  1.  Tissue  color  changes" 
option$(2,  1)="  2.  Vesicles,  bullae,  or  ulcers" 
option$(3, 1)="  3.  Nodules  or  enlargements" 
option$(4, 1)="  4.  None  of  the  above" 

longest=32 

numops=4 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

SZ=ans 

response(82)=SZ 

pause!=timer+.5 

do  while  TIMER  <  pause! 

loop 


IF  SZ  =  1  THEN  GOTO  20970 
IF  SZ  =  2  THEN  GOTO  21730 
IF  SZ  =  3  THEN  GOTO  21870 
IF  SZ  =  4  THEN  GOTO  softmenu 


20970  call  scrollup  (begr+1,  begc+1,  endr-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="What  is  the  color  of  the  tissue  lesion(s)?" 


DENTAL  Programmer’ s  Manual  A-116 


option$(l,  1)="  1.  White" 
option$(2, 1)="  2.  Red" 
option$(3, 1)*"  3.  Brown  and/or  black” 
option$(4, 1)="  4.  Blue  and/or  purple" 
option$(5, 1)="  5.  Yellow" 
option$(6, 1)="  6.  None  of  the  above" 

longest=22 

numops=6 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

SC=ans 

response(83)=SC 

pause!=timer+.5 

do  while  TIMER  <  pause! 

loop 


IF  SC  =  1  THEN  GOTO  21 140 
IF  SC  =  2  THEN  GOTO  21300 
IF  SC  =  3  THEN  GOTO  21410 
IF  SC  =  4  THEN  GOTO  21530 
IF  SC  =  5  THEN  GOTO  21630 
E;  SC  -  6  THEN  GOTO  softmenu 


21140  call  scrollup  (begr+1,  begc+1,  endr-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="What  is  the  nature  of  the  white  le3ion(s)?" 

option$(l,  1)="  1.  Keratotic  non-sloughing,  non-ulcerated,  non-eroded,  " 

option$(l,  2)="  non-papillary  lesion(s)" 
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option$(2,  1)="  2.  Keratotic  non-sloughing,  non-ulcerated,  non-eroded, " 
option$(2, 2)="  papillary  lesion(s)" 

option$(3,  1)="  3.  Keratotic  non-sloughing,  ulcerated,  eroded, " 

option$(3, 2)="  non-papillary  lesion(s)" 

option$(4,  1)="  4.  Keratotic  non-sloughing,  ulcerated,  eroded, " 

option$(4, 2)="  papillary  lesion(s)" 

option$(5,  1)="  5.  Non-keratotic,  sloughing  lesion(s)" 

option$(6, 1)="  6.  None  of  the  above" 

longest=56 

numops=6 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


MW=ans 

response(84)=MW 

pause!=timer+.5 

do  while  TIMER  <  pause! 

loop 


IF  (MW  =  6)  THEN  GOTO  softmenu 

IF  (MW  =  1)  OR  (MW  =  2)  OR  (MW  =  3)  OR  (MW  =  4)  OR  (MW  =  5)  THEN  GOTO 
printdg 


21300  call  scrollup  (begr+1,  begc+1,  endr-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="What  is  the  nature  of  the  red  lesion(s)?" 
option$(l,  1)="  1.  Single  exophytic  lesion" 
option$(2,  1)="  2.  Single  non-exophytic  lesion" 
option$(3,  1)="  3.  Generalized  or  multiple  exophytic  lesions" 
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option$(4, 1)="  4.  Generalized  or  multiple  non-exophytic  lesions" 
option$(5, 1)="  5.  None  of  the  above" 

longest=50 

numops=5 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


MR=ans 

response(85)=MR 

pause!=timer+.5 

do  while  TIMER  <  pause! 

loop 


EF  MR=5  THEN  GOTO  softmenu 

IF  (MR  =  1)  OR  (MR  =  2)  OR  (MR  =  3)  OR  (MR  =  4)  THEN  GOTO  printdg 


21410  call  scrollup  (begr+1,  begc+1,  endr-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="What  is  the  nature  of  the  brown  and/or  black  lesion(s)?" 

option$(l,  1)=”  1.  Single  exophytic  lesion" 
option$(2,  1)="  2.  Single  non-exophytic  lesion" 
option$(3,  1)="  3.  Generalized  or  multiple  exophytic  lesions" 
option$(4,  1)="  4.  Generalized  or  multiple  non-exophytic  lesions" 
option$(5,  1)="  5.  None  of  the  above" 

longest=50 

numops=5 

qrow=2 
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qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


MB=ans 

response(86)=MB 

pause!  =timer+.5 

do  while  TIMER  <  par' 

loop 


IF  MB  -  5  THEN  GOTO  softmenu 

IF  (MB  =  1)  OR  (MB  =  2)  OR  (MB  =  3)  OR  (MB  =  4)  THEN  GOTO  printdg 


21530  call  scrollup  (begr+1,  begc+1,  endr-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="What  is  the  nature  of  the  blue  and/or  purple  lesion(s)?" 
option$(l,  1)="  1.  Single  lesion" 
option$(2,  1)="  2.  Generalized  or  multiple  lesions" 
option$(3,  1)=”  3.  None  of  the  above" 

longest=36 

numops=3 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
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goto  softmenu 
end  if 

MP=ans 

response(87)=MP 

pause!=timer+.5 

do  while  TIMER  <  pause! 

loop 


IF  MP  =  3  THEN  GOTO  softmenu 

IF  (MP  =  1)  OR  (MP  =  2)  THEN  GOTO  printdg 


21630  call  scrollup  (begr+1,  begc+1,  endr-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="What  is  the  nature  of  the  yellow  lesion(s)?" 
option$(l,  1)="  1.  Single  lesion" 
option$(2, 1)="  2.  Generalized  or  multiple  lesions" 
option$(3,  1)="  3.  None  of  the  above" 

longest=36 

numops=3 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

MY=ans 

response(88)=MY 

pause!=timer+.5 

do  while  TIMER  <  pause! 

loop 
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IF  MY  =  3  THEN  GOTO  softmenu 

IF  (MY  =  1)  OR  (MY  =  2)  THEN  GOTO  printdg 


21730  call  scrollup  (begr+1,  begc+1,  endr-1,  endc-1,  scrollines,  attrib) 
call  initoptions 

ques$="Which  of  the  following  describe  the  condition? 

option$(l,  1)="  1.  Acute  vesicles" 

option$(2,  1)="  2.  Chronic  vesicles" 

option$(3,  1)="  3.  Acute  bullae" 

option$(4,  1)="  4.  Chronic  bullae" 

option$(5,  1)="  5.  Acute  ulcers" 

option$(6,  1)="  6.  Chronic  ulcers" 

option$(7,  1)="  7.  None  of  the  above" 

longest=21 

numops=7 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

SH=ans 

response(89)=SH 

pause!=timer-t-.5 

do  while  TIMER  <  pause! 

loop 


IF  SH  =  7  THEN  GOTO  softmenu 

IF  (SH  =  1)  OR  (SH  =  2)  OR  (SH  =  3)  OR  (SH  =  4)  OR  (SH  -5)  OR  (SH  =  6) 
THEN  GOTO  printdg 


DENTAL  Programmer’ s  Manual  A- 122 


21870  call  scrollup  (begr+1,  begc+1,  endr-1,  endc-1,  scrollines,  attrib) 
call  initoptions 


ques$=”Which  of  the  following  descriptions  applies?" 
option$(l,  1)="  1.  Small  firm  non-hemorrhagic,  lobulated  lesions" 
option$(2,  1)="  2.  Extensive  firm  non-hemorrhagic,  lobulated  lesions" 
option$(3,  1)="  3.  Single  firm  non-hemorrhagic  nodule" 
option$(4,  1)="  4.  Multiple  firm  non-hemorrhagic  nodules" 
option$(5, 1)="  5.  Single  bony  lump  or  nodule" 
option$(6, 1)="  6.  Multiple  or  extensive  bony  enlargements  or  nodules" 
option$(7, 1)="  7.  None  of  the  above” 

longest=55 

numops=7 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

Sl=ans 

response(90)=SI 

pause!=timer+.5 

do  while  TIMER  <  pause! 

loop 


IF  SI  =  7  THEN  GOTO  softmenu 

IF  (SI  =  1)  OR  (SI  =  2)  OR  (SI  =  3)  OR  (SI  =  4)  OR  (SI  =  5)  OR  (SI  =  6) 
THEN  GOTO  printdg 


22010  call  scrollup  (begr+1,  begc+1,  endr-1,  endc-1,  scrollines,  attrib) 
call  initoptions 
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ques$="Which  of  the  following  categories  applies?" 
option$(l,  1)="  1.  Macroglossia  (enlarged  tongue)" 
option$(2,  1)="  2.  Microglossia  (small  tongue)" 
option$(3, 1)="  3.  Cleft  in  tongue" 
option$(4, 1)="  4.  Fissured  tongue" 
option$(5, 1)="  5.  Supernumerary  tongue" 
option$(6, 1)="  6.  Smooth  tongue" 
option$(7,  1)="  7.  Glossodynia  (pain  in  tongue)" 
option$(8, 1)="  8.  None  of  the  above" 

longest=35 

numops=8 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

SJ=ans 

response(91)=SJ 

pause!  =timer+.5 

do  while  TIMER  <  pause! 

loop 


IF  SJ  =  8  THEN  GOTO  softmenu 

IF  (SJ  =  1)  OR  (SJ  =  2)  OR  (SJ  =  3)  OR  (SJ  =  4)  OR  (SJ  =  5)  OR  (SJ  =  6) 
OR  (SJ  =  7)  THEN  GOTO  printdg 


22 1 60  call  scrollup  (begr+ 1 ,  begc+ 1 ,  endr- 1 ,  endc- 1 ,  scrollines,  attrib) 

call  initoptions  ! 

ques$="Which  of  the  following  applies  to  the  mass(es)?" 
option$(l,  1)="  1.  Acute  parotid  swelling" 

4 
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option$(2,  1)=’’  2.  Chronic  parotid  swelling" 
option$(3, 1)="  3.  Acute  discrete  nodules,  non-parotid  area" 
option$(4,  1)="  4.  Chronic  discrete  nodules,  non-parotid  area" 
option$(5, 1)="  5.  Acute  extensive  diffuse  swelling,  non-parotid  area" 
option$(6, 1)="  6.  Chronic  extensive  diffuse  swelling,  non-parotid  area" 
option$(7, 1)="  7.  None  of  the  above" 

longest=57 

numops=7 

qrow=2 

qcol=5 

call  priques((ques$)) 
call  prioptions 
ans=0 
call  getresp 

if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

SK=ans 

response(92)=Sk 

pause!=timer+.5 

do  while  TIMER  <  pause! 

loop 


IF  SK  =  7  THEN  GOTO  softmenu 

IF  (SK  =  1)  OR  (SK  =  2)  OR  (SK  =  3)  OR  (SK  =  4)  OR  (SK  =5)  OR  (SK  =  6) 
THEN  GOTOprintdg 


REM  Write  data  to  disk. 

printdg: 

call  wrtdat 

REM  Clear  screen,  draw  box,  display  differential  diagnosis. 
printdgagain: 

call  scrollup  (begr+1,  begc+1,  endr,  endc-1,  scrolling,  attrib) 
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call  box  (begr,  begc,  endr-1,  endc) 
color  highlight,  bground 
locate  2,  28:PRINT  "Differential  Diagnosis" 
locate  24,  l:color  keyline2,  keyline2: print  space$(80); 
locate  24, 5:color  normal,  bground:print "  Shift  +  PrtSc  ";:color  keylettr2, 
keyline2:print "  Print  Screen"; 

locate  24,  37:color  normal,  bgroundrprint "  PgDn  ";:color  keylettr2, 
keyline2:print "  Next  Page"; 

locate  24,  59:color  normal,  bground:print  "  PgUp  ";:color  keylettr2, 

keyline2:print  ”  Previous  Page"; 

locate  25, 1 : color  keyline,  keylinetprint  space$(80); 

locate  25, 5:color  normal,  bgroundrprint "  F9  ";:color  keylettr, 

keyline:print "  Main  Menu"; 

locate  25, 26:color  normal,  bground:print "  F10  ";:color  keylettr, 

keylinerprint "  Soft  Tissue  Lesions  Menu"; 

locate  25,  59:color  normal,  bground:print  "  F7  ";:color  keylettr, 

keyline:print "  Definitions"; 

color  normal,  bground 

if  sb=l  then 

locate  4,  22:color  highlight,  bground:PRINT  "Desquamative  Lesions  of 
Gingiva"  :color  normal,  bground 

locate  6, 22:PRINT  "1.  ";chr$(34);"Desquamative  gingivitis";chr$(34) 
locate  7, 22:PRINT  "2.  Hormonal  changes  (ex.  Puberty)" 
locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  8, 22:PRJNT  "3.  Bullous  lichen  planus" 
locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  9, 22:PRINT  "4.  Benign  mucous  membrane  pemphigoid" 
locate  10,  22:PRINT  "5.  Nutritional  deficiencies" 
locate  11,  22:PRINT  "6.  Pernicious  anemia" 
locate  12, 22:PRINT  "7.  Atopic  and  contact  stomatitis" 
locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  13,  22:PRINT  "8.  Drug  idiosyncrasies" 
locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  14, 22:PRINT  "9.  Erythema  multiforme" 
locate  15,  22:PRINT  "10.  Primary  herpes  simplex" 
locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  16,  22:PR1NT  ”11.  Pemphigus  vulgaris" 
locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  17,  22:PRINT  ”12.  Epidermolysis  bullosa" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
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elseif  ans=68  then 
I  goto  softmenu 

end  if 

elseif  sb=2  then 

23540  color  highlight,  bground 

locate  4, 24:PRINT  "Atrophy  or  Ulceration  of  Gingiva" 
color  normal,  bground 

locate  6,  8:PRINT  "1.  Necrotizing  ulcerative  gingivitis  (NUG,  ANUG)" 
locate  ,  6:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  7,  8:PRINT  "2.  Diabetes  mellitus  (uncontrolled)" 
locate  ,  6:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  8,  8:PRINT  "3.  Leukemia  (late)" 

locate  ,  6:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  9,  8:PRINT  "4.  Cyclic  neutropenia" 
locate  10,  8 .PRINT  "5.  Syphilis" 
locate  11,  8:PRINT  "6.  Gonorrhea" 

locate  12,  8:PRINT  "7.  Herpetic  gingivostomatitis  (primary)" 
locate  ,  6:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  13,  8:PRINT  "8.  Erythema  multiforme" 
locate  14,  8:PRINT  "9.  Habits/trauma" 
locate  15,  8:PRINT  "10.  Nutritional  deficiency" 
locate  ,  6:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
|  locate  16,  8:PRINT  "11.  Lupus  vulgaris" 

locate  ,  6:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  17,  8:PRINT  "12.  Porphyria" 
locate  18,  8:PRINT  "13.  Apthous  stomatitis" 
locate  19,  8:PRINT  "14.  Periadenitis  mucosa  necrotica  recurrens 
(Sutton’s  disease)" 

locate  ,  6:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  20,  8:PRINT  "15.  ARC/AIDS" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

elseif  sb=3  then 

23740  color  highlight,  bground 

locate  4, 13:PRINT  "Localized  Hyperplastic,  Hemorrhagic  Lesions  of 
Gingiva" 

color  normal,  bground 


\ 
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locate  6,  13:PRINT  "1.  Pyogenic  granuloma" 
locate  7, 13:PRINT  ”2.  Peripheral  giant  cell  granuloma" 
locate  8,  13:PRINT  "3.  Food  impaction  (early)" 
locate  ,  1  l:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  9,  13:PRINT  "4.  Metastatic  tumor" 
locate  ,  1  lrcolor  astrsk,  bground:print  "*";:color  normal,  bground 
locate  10, 13.PRINT  "5.  Mycotic  infection" 
locate  11, 13:PRINT  "6.  Fistulous  tract  from  periapical 
abscess/parulis" 

locate  ,  1  lrcolor  astrsk,  bground:print  "*";:color  normal,  bground 

locate  12,  13:PRINT  "7.  Hyperparathyroidism  (brown  tumor)" 

locate  ,  1  lrcolor  astrsk,  bground:print  "*";:color  normal,  bground 

locate  13,  13:PRINT"8.  Local  malignancy" 

locate  ,  1  lrcolor  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  14,  13:PRJNT”9.  Pericoronitis" 

locate  15,  13:PRINT  "10.  Epulis  granulomatosum" 

locate  16,  13:PRINT  "11.  Antral  polyp  from  oroantral  fistula" 

locate  17,  13:PRINT  "12.  Pulp  polyp" 

locate  18,  13:PRINT  "13.  Hemangioma" 

locate  ,  1 1  rcolor  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  19,  13:PRINT  "14.  Kaposi’s  sarcoma/ARC/AIDS" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sb=4  then 

23940  color  highlight,  bground 

locate  4,  1  lrPRINT  "Generalized  Hyperplastic,  Hemorrhagic  Lesions  of 
Gingiva" 

color  normal,  bground 

locate  6,  20:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  6,  22:PRINT  "1.  Leukemia  (early)" 

locate  7,  22:PRINT  "2.  Gingivitis" 

locate  8,  22:PRINT  "3.  Hormonal  changes  (ex.  puberty)" 

locate  9,  22:PRINT  ”4.  Xerostomia  (dry  mouth)" 

locate  10,  22:PRINT  "5.  Mouth  breathing" 

locate  ,  20:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  1 1, 22:PRINT  ”6.  Diabetes  (uncontrolled)" 

locate  ,  20:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
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locate  12, 22:PRINT  "7.  Wegener’s  granulomatosis" 
locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  13, 22:PRINT  "8.  Cyclic  neutropenia" 
locate  ,  20:color  astrsk,  bgroundiprint  "*";:color  normal,  bground 
locate  14, 22:PRINT  "9.  Cushing’s  syndrome" 
locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  15, 22:PRINT  "10.  Yellow  fever" 
locate  16, 22:PRINT  "11.  Scurvy" 
locate  17, 22:PRINT  "12.  Vitamin  A  deficiency" 
locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  18, 22:PRINT  "13.  Crohn’s  disease" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sb=5  then 

24130  color  highlight,  bground 

locate  4,  1 1  :PRINT  "Localized  Hyperplastic,  Non-hemorrhagic  Lesions  of 
Gingiva" 

color  normal,  bground 
locate  6,  23:PRINT  "1.  Irritation  fibroma" 
locate  7,  23:PRINT  ”2.  Epulis  fissuratum" 
locate  8, 23:PRINT  "3.  Giant  cell  fibroma" 
locate  9, 23:PRINT  "4.  Peripheral  ossifying  fibroma" 
locate  10,  23:PRINT  "5.  Pulp  polyp" 
locate  11, 23:PRINT  "6.  Traumatic  neuroma" 
locate  12,  23:PRINT  "7.  Neurofibroma" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sb=6  then 

24260  color  highlight,  bground 

locate  4, 7:PRINT  "Generalized  Hyperplastic,  Non-hemorrhagic  Lesions  of 
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the  Gingiva" 

color  normal,  bground 

locate  6,  13:PRINT  "1.  Idiopathic  gingival  fibromatosis" 
locate  7,  13:PRINT  "2.  Hereditary  gingival  fibromatosis" 
locate  8,  13:PRINT  "3.  Gingival  hyperplasia,  drug-induced  (ex. 
Dilantin)" 

locate  9,  13.PRINT  "4.  Amyloidosis" 
locate  10, 13:PRINT  "5.  Hemifacial  hypertrophy" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sb=7  then 

24370  color  highlight,  bground 

locate  4,  26:PRINT  "Cystic  Lesions  of  Gingiva" 
color  normal,  bground 
locate  7,  26:PRINT  ”1.  Eruption  cyst" 
locate  8,  26.PRINT  "2.  Gingival  cyst" 
locate  9,  26:PRINT  "3.  Parulis" 
locate  10,  26:PRINT  "4.  Nasoalveolar  cyst" 
locate  11,  26.PRINT  "5.  Nasopalatine  duct  cyst" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  mw=l  then 
mwl: 

color  highlight,  bground 

locate  4, 4:PRINT  "Keratotic  Non-sloughing,  Non-ulcerated,  Non-eroded, 
Non-papillary  Lesions" 
color  normal,  bground 
locate  6,  23:PRINT  "1.  Linea  alba" 
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locate  7,  23:PRINT  "2.  Hyperkeratosis  (leukoplakia)" 
locate  8, 23:PRINT  "3.  Nicotine  stomatitis" 
locate  9, 23:PRINT  ”4.  Snuff/tobacco  pouch" 
locate  10, 23:PRINT  "5.  Actinic  cheilosis" 
locate  11, 23:PRINT  "6.  Leukoedema" 
locate  12, 23:PRINT  "7.  Scar  tissue" 
locate  13, 23:PRINT  "8.  Lichen  planus" 
locate  14,  23:PRINT  "9.  Syphlitic  glossitis" 
locate  15, 23:PRINT  "10.  White  sponge  nevus" 
page=l:npages=2 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-2,  endc-1,  scrollines,  attrib) 
color  highlight,  bground 

locate  4,  4:PRINT  "Keratotic  Non-sloughing,  Non-ulcerated,  Non-eroded, 
Non-papillary  Lesions" 
color  normal,  bground 

locate  6,  23:PRINT  "11.  Benign  hereditary  intra-epithelial 
dyskeratosis" 

locate  7,  23:PRINT  "12.  Pachyonychia  congenita" 
locate  8,  23:PRJNT  "13.  Dyskeratosis  congenita" 
locate  9,  23:PRINT  "14.  Acanthosis  nigricans  (buccal  only)" 
locate  10, 23:PRINT  "15.  Hyperkeratosis  palmo-plantaris  and  gingivae" 
locate  1 1,  23:PRINT  "16.  Submucous  fibrosis" 
locate  12,  23:PRINT  "17.  Skin  graft" 
locate  13,  23:PRINT  "18.  Hypovitaminosis  A" 
locate  14,  23:PRINT  "19.  Syphilitic  glossitis  (rare)" 
page=2:npages=2 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
elseif  ans=73  then 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-2,  endc-1,  scrollines,  attrib) 
goto  mwl 
end  if 
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elseif  mw=2  then 

24750  color  highlight,  bground 

locate  4,  5:PRINT  "Keratotic  Non-sloughing,  Non-ulcerated,  Non-eroded, 
Papillary  Lesions" 

color  normal,  bground 
locate  6, 25:PRINT  "1.  Fordyce  granules" 
locate  7, 25:PRINT  "2.  White  hairy  tongue" 
locate  8, 25:PRINT  "3.  Verrucous  hyperkeratosis" 
locate  9, 25:PRINT  "4.  Papilloma/papillomatosis 
locate  10, 25:PRINT  "5.  Vemica  vulgaris" 
locate  ,  23:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  11, 25:PRINT  "6.  Verrucous  carcinoma" 
locate  ,  23:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  12,  25:PR1NT  "7.  Koplick  spots  (measles)" 
locate  13,  25:PRINT  "8.  Verrucous  xanthoma" 
locate  14,  25:PRINT  "9.  Epidermoid  cyst" 
locate  15,  25:PRINT  "10.  Lymphoepithelial  cyst" 
locate  16,  25:PRINT  "11.  Acanthosis  nigricans" 
locate  ,  23:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  17,  25:PRINT  "12.  Darier’s  disease" 
locate  ,  23:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  18,  25:PRINT  "13.  Hairy  leukoplakia/ARC/AIDS" 
page=l:npages=l 
call  diffpTessret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  mw=3  then 

24930  color  highlight,  bground 

locate  4, 6:PRINT  "Keratotic  Non-sloughing,  Ulcerated,  Eroded, 
Non-papillary  Lesions" 
color  normal,  bground 

locate  6,  20:PRINT  "1.  Hyperkeratosis  (speckled  leukoplakia)" 

locate  7,  20:PRINT  "2.  Nicotine  stomatitis" 

locate  8,  20:PRINT  "3.  Actinic  cheilosis" 

locate  9,  20:PRINT  "4.  Chronic  cheek  biting" 

locate  10,  20:PRINT  "5.  Geographic  tongue" 

locate  11,  20:PRJNT  "6.  Benign  migratory  stomatitis  (ectopic 
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geographic  tongue)" 

locate  ,  18:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  12,  20:PRINT  "7.  Erosive  lichen  planus" 
locate  ,  18:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  13, 20:PRINT  "8.  Premalignant  epithelial  dysplasia" 
locate  ,  18:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  14, 20:PRINT  "9.  Carcinoma  in  situ" 
locate  ,  18:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  15, 20:PRINT  "10.  Squamous  cell  carcinoma" 
locate  16, 20:PRINT  "11.  Syphilitic  glossitis" 
locate  17, 20:PRINT  "12.  Discoid  lupus  erythematosus" 
locate  ,  18:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  18, 20:PRINT  "13.  Reiter’s  disease" 
locate  19, 20:PRINT  "14.  Oral  psoriasis" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  mw=4  then 

25130  color  highlight,  bground 

locate  4,  8:PRINT  "Keratotic  Non-sloughing,  Ulcerated,  Eroded, 
Papillary  lesions" 

color  normal,  bground 

locate  6, 24:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  6,  26:PRINT  "1.  Verrucous  carcinoma" 
locate  7,  24:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  7,  26:PRINT  "2.  Squamous  cell  carcinoma" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  mw=5  then 
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25210  color  highlight,  bground 

locate  4, 23:PRINT  "Sloughing,  Non-keratotic  Lesions" 

color  normal,  bground 

locate  6,  23:PRINT  "1.  Materia  alba/plaque" 

locate  7, 23:PRINT  "2.  Sloughing  traumatic  lesions" 

locate  8, 23:PRINT  "3.  Candidiasis  (moniliasis)" 

locate  9,  23:PRINT  "4.  White-coated  tongue" 

locate  10, 23:PRINT  "5.  Chemical  bum  (ex.  ASA)" 

locate  1 1, 23:PRINT  "6.  Thermal  bum" 

locate  12, 23:PRINT  "7.  Stomatitis  venenata" 

locate  13,  23:PRINT  "8.  Stomatitis  medicamentosa" 

locate  14, 23.PRINT  "9.  Radiation  mucositis" 

locate  ,  21  :color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  15,  23.PRINT  "10.  Diptheria" 

locate  ,  21:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  16,  23:PRINT  "11.  Ulcer/bed  (various  diseases)" 
locate  ,  21  :color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  17, 23:PRINT  "12.  Noma  (rare) 

locate  ,  21:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  18,  23:PRINT  "13.  Heavy  metal  poisoning" 
locate  19,  23:PRINT  "14.  ";chr$(34);"Snuff-dipper’s  lesion";chr$(34) 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  mr=l  then 

25410  color  highlight,  bground 

locate  4,  25:PRINT  "Single  Exophytic  Red  Lesions" 

color  normal,  bground 

locate  6, 19:PRINT  "1.  Hematoma" 

locate  7, 19:PRINT  "2.  Hemangioma" 

locate  ,  17:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  8,  19:PRINT  "3.  Pericoronitis" 

locate  9,  19:PRINT  "4.  Pyogenic  granuloma" 

locate  10,  19:PRINT  "5.  Peripheral  giant  cell  granuloma" 

locate  ,  17:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  11, 19:PRINT  "6.  Squamous  cell  carcinoma" 

locate  ,  17:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  12,  19:PRINT  "7.  Mycotic  infection" 
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locate  13, 19.PRINT  "8.  Median  rhomboid  glossitis" 
locate  14, 19:PRINT  "9.  Traumatic  angiomatous  lesion" 
locate  15, 19:PRINT  "10.  Eruption  cyst" 
locate  16, 19:PRINT  "11.  Abscess  (periodontal  or  endodontic)" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  mr=2  then 

25580  color  highlight,  bground 

locate  4, 23:PRINT  "Single  Non-exophytic  Red  Lesions" 
color  normal,  bground 

locate  6, 21:PRINT  "1.  Hemangioma,  Sturge-Weber  syndrome" 

locate  7,  21:PRINT  "2.  Bums  (thermal  or  chemical)" 

locate  8, 21  -.PRINT  "3.  Non-specific  inflammation" 

locate  9,  21:PRINT  ”4.  Trauma  (ex.  denture  sore)" 

locate  ,  19:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  10,  21:PRINT  ”5.  Carcinoma  in  situ" 

locate  ,  19:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  11,  21:PRINT  "6.  Squamous  cell  carcinoma" 

locate  ,  19:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  12,  21:PRINT  "7.  Erythroplakia" 

locate  ,  19:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  13,  21:PRINT  "8.  Ulcers  (see  ulcers)" 
locate  14,  21:PRINT  "9.  Median  rhomboid  glossitis" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  mr=3  then 

25730  color  highlight,  bground 

locate  4,  16:PRINT  "Generalized  or  Multiple  Exophytic  Red  Lesions" 
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color  normal,  bground 

locate  6, 18:PRINT  "1.  Gingivitis  (see  other  gingival  diseases)"  I 

locate  7, 18:PRINT  "2.  Hemangiomas" 
locate  8, 18:PRINT  "3.  Hematomas/purpuras" 
locate  9, 18:PRINT  "4.  Lymphangioma" 
locate  10, 18:PRINT  "5.  Papillary  hyperplasia  of  the  palate" 
locate  11, 18:PRINT  "6.  Lingual  varicosities" 
locate  ,  16:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  12, 18.PRINT  "7.  Pyostomatitis  vegetans" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  mr=4  then 
mr4: 

color  highlight,  bground 

locate  4,  15:PRINT  "Generalized  or  Multiple  Non-exophytic  Red  Lesions" 
color  normal,  bground 

locate  6, 19:PRINT  "1.  Hemangiomas,  Sturge- Weber  syndrome" 

locate  7,  19:PRINT  "2.  Hereditary  hemorrhagic  telangiectasia" 

locate  ,  17:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  8, 19:PRINT  "3.  Erythema  multiforme" 

locate  ,  17:color  astrsk,  bground:prlnt  "*";:color  normal,  bground 

locate  9,  19:PRINT  "4.  Allergic  reaction" 

locate  10,  19:PRINT  "5.  Non-specific  inflammation" 

locate  11, 19:PRINT  "6.  Radiation  stomatitis/xerostomia" 

locate  12, 19:PRINT  "7.  Denture  sore  mouth  (candidiasis)" 

locate  ,  17:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  13, 19:PRINT  "8.  Scarlet  fever" 

locate  ,  17:color  astrsk,  bground.print  "*";:color  normal,  bground 
locate  14, 19:PRINT  "9.  Measles" 
locate  15,  19:PRINT  "10.  Geographic  tongue" 
locate  16, 19:PRINT  ”11.  Vitamin  deficiencies" 
locate  17,  19:PRINT  "12.  Nicotine  stomatitis  (early)" 
page=l:npages=2 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
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elseif  ans=68  then 
goto  softmenu 
end  if 


CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-2,  endc-1,  scrollines,  attrib) 
color  highlight,  bground 

locate  4, 15:PRINT  "Generalized  or  Multiple  Non-exophytic  Red  Lesions" 
color  normal,  bground 

locate  6, 22:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  6,  24:PRINT  "13.  Petechiae:" 
locate  7,  24:PRINT  "  -  Leukemias" 

locate  8,  24:PRINT  "  —  Anemias" 

locate  9,  24:PRINT  ”  —  Purpuras" 

locate  10,  24:PRINT "  —  Hemophilias" 

locate  1 1 , 24:PRINT  "  —  Mononucleosis" 

locate  12,  24:PRINT  "  -  Fellatio  trauma" 

locate  13,  24:PRINT  "  —  Other  trauma” 

locate  14,  24:PRINT  "  —  Chronic  cough" 

locate  15,  24:PRINT  "14.  Lupus  erythematosus" 
page=2:npages=2 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
elseif  ans=73  then 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-2,  endc-1,  scrollines,  attrib) 
goto  mr4 
end  if 


elseif  mb=l  then 

26160  color  highlight,  bground 

locate  4, 18:PRINT  "Single  Exophy:ic  Brown  and/or  Black  Lesions" 

color  normal,  bground 

locate  6, 15:PRINT  "1.  Hematoma" 

locate  7,  15:PRINT  "2.  Pigmented  nevi" 

locate  8,  15:PRINT  "3.  Pigmented  irritation  fibroma" 

locate  ,  13:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  9,  15 .PRINT  "4.  Malignant  melanoma" 

locate  10,  15:PRINT  "5.  Black  hairy  tongue" 

locate  ,  13:color  astrsk,  bground:print  "*";:color  normal,  bground 
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locate  11, 15:PRINT  "6.  Peripheral  giant  cell  granuloma 
(long-standing)" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  mb=2  then 

26280  color  highlight,  bground 

locate  4,  16:PRINT  "Single  Non-exophytic  Brown  and/or  Black  Lesions" 
color  normal,  bground 
locate  6, 24:PRINT  "1.  Amalgam  tatoo" 
locate  7,  24:PRINT  "2.  Non-amalgam  tatoo" 
locate  8, 24:PRINT  "3.  Ephelis/lentigo  (freckle)" 
locate  ,  22:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  9,  24:PRINT  "4.  Malignant  melanoma" 
locate  10,  24:PRINT  "5.  Graphite  tatoo  from  pencil" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  mb=3  then 

26390  color  highlight,  bground 

locate  4,  9:PRINT  "Generalized  or  Multiple  Exophytic  Brown  and/or  Black 
Lesions" 

color  normal,  bground 

locate  6,  23:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  6,  25:PRINT  "  1.  Malignant  melanoma" 

locate  ,  23:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  7,  25:PRINT  "  2.  Purpuras  (long-standing)" 

page=l:npages=l 

call  diffpressret 

if  ans=67  then 
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goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  mb=4  then 

26470  color  highlight,  bground 

locate  4, 7:PRINT  "Generalized  or  Multiple  Non-exophytic  Brown  and/or 
Black  Lesions" 

color  normal,  bground 

locate  6, 21:color  astrsk,  bground.print  "*";:color  normal,  bground 
locate  6,  23:PRINT  "1.  Malignant  melanoma" 
locate  7,  23:PRINT  ”2.  Physiologic  melanosis  (racial  pigmentation)" 
locate  8, 23:PRINT  "3.  Peutz-Jeghers  syndrome" 
locate  ,  21  :color  astrsk,  bground:print  ;:color  normal,  bground 
locate  9, 23:PRINT  "4.  Addison’s  disease" 
locate  ,  21  :color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  10,  23:PRINT  "5.  Heavy  metal  poisoning" 
locate  ,  21  :color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  11,  23:PRINT  "6.  Drug  ingestion  (chloroquine)" 
locate  12,  23:PRINT  "7.  Syphilis  (secondary)" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  mp=l  then 

26600  color  highlight,  bground 

locate  4, 20:PRINT  "Single  Blue  and/or  Purple  Lesions" 

color  normal,  bground 

locate  6, 22:PRINT"1.  Mucocele" 

locate  7, 22:PRINT  "2.  Ranula" 

locate  8, 22:PRINT  "3.  Eruption  cyst" 

locate  9,  22:PRINT  "4.  Hematoma" 

locate  10,  22:PRINT  "5.  Hemangioma" 

locate  11,  22:PRINT  "6.  Traumatic  angiomatous  lesion" 
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locate  12,22:PRINT"7.  Blue  nevus" 

locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  13, 22:PRINT  "8.  Mucoepidermoid  carcinoma" 
locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  14, 22:PRINT  "9.  Malignant  melanoma" 
locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  15, 22:PRINT  "10.  Cystic  pleomorphic  adenoma" 
locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  16,  22:PRINT  "11.  Kaposi’s  sarcoma/ARC/AIDS" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  mp=2  then 

26760  color  highlight,  bground 

locate  4, 14:PRINT  "Generalized  or  Multiple  Blue  and/or  Purple  Lesions" 

color  normal,  bground 

locate  6, 27 ‘.PRINT  "1.  Lingual  varicosities" 

locate  7,  27:PRINT  "2.  Hemangiomas" 

locate  8,  27:PRINT  "3.  Lymphangiomas” 

locate  ,  25:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  9,  27:PRINT  "4.  Purpuras" 

locate  ,  25:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  10,  27:PRINT  "5.  Cyanosis" 

locate  ,  25:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  11,  27:PRINT  "6.  Kaposi’s  sarcoma/ARC/AIDS" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  my=l  then 

26870  color  highlight,  bground 

locate  4,  28:PRINT  "Single  Yellow  Lesions" 
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color  normal,  bground 

locate  6, 15:PRINT  "1.  Lipoma" 

locate  7, 15:PRINT  "2.  Epidermoid/dermoid  cyst" 

locate  8, 15:PRINT  "3.  Lymphoepithelial  cyst" 

locate  9, 15:PRINT  "4.  Xanthoma" 

locate  10, 15:PRINT  "5.  Superficial  abscess/fistula" 

locate  11, 15:PRINT  "6.  Benign  lymphoid  aggregate" 

locate  12, 15:PRINT  "7.  Yellow  hairy  tongue" 

locate  13, 15:PRINT  "8.  Benign  lymphoepithelial  cyst  (floor  of  mouth)" 
locate  14, 15:PRINT  "9.  Verrucous  xanthoma" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  my=2  then 

27020  color  highlight,  bground 

locate  4, 20:PRINT  "Generalized  or  Multiple  Yellow  Lesions" 

color  normal,  bground 

locate  6, 24:PRINT  ”1.  Fordyce  granules" 

locate  ,  22:color  astrsk,  bgroundiprint  "*";:color  normal,  bground 

locate  7, 24:PRINT  "2.  Jaundice/icterus" 

locate  8, 24:PRINT  "3.  Crusting:" 

locate  9,  24:PRINT  "  —  Actinic  cheilitis" 

locate  10,  24:PRINT  "4.  Crusting  from  herpes" 

locate  1 1, 24:PRINT "  —  Herpes  zoster" 

locate  12,  24:PRINT "  —  Herpes  simplex" 

locate  13, 24:PRINT  "5.  Benign  lymphoid  aggregate" 

locate  14, 24.PRINT  "6.  Tonsillar  (keratotic)  plugs" 

locate  15,  24:PRINT  "7.  Lipoid  proteinosis" 

locate  ,  22:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  16,  24:PRINT  "8.  Carotenemia" 

locate  ,  22:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  17,  24:PRINT  "9.  Pyostomatitis  vegetans" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
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end  if 


elseif  sh=l  then 

27200  color  highlight,  bground 

locate  4, 27:PRINT  "Acute  Vesicular  Lesions" 

color  normal,  bground 

locate  6, 24:PRINT  "1.  Herpes  simplex" 

locate  7, 24:PRINT  "2.  Herpes  zoster" 

locate  8, 24:PRINT  "3.  Herpangina" 

locate  9, 24:PRINT  "4.  Hand-foot-mouth  disease" 

locate  10, 24:PRINT  "5.  Chickenpox" 

locate  ,  22:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  11, 24-.PRINT  "6.  Allergic  reactions" 
locate  12,  24:PRINT  "7.  Dermatitis  herpetiformis" 
locate  ,  22:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  13,  24:PRINT  "8.  Erythema  multiforme  (early)" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sh=2  then 

27340  color  highlight,  bground 

locate  4,  18:PRINT  "Chronic  Vesicular  Lesions  (Pseudovesicles)" 
color  normal,  bground 
locate  6,  25:PRINT  "1.  Mucocele" 
locate  7,  25:PRINT  "2.  Parulis" 
locate  8,  25:PRINT  "3.  Benign  lymphoid  aggregate" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sh=3  then 

27430  color  highlight,  bground 
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locate  4, 28:PRINT  "Acute  Bullous  Lesions" 
color  normal,  bground 

locate  6, 26:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  6, 28:PRINT "  1.  Allergic  reaction" 
locate  ,  26:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  7, 28.PRINT  "  2.  Erythema  multiforme" 
page=l:npages=l 
call  diffprcssret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sh=4  then 

27510  color  highlight,  bground 

locate  4, 27:PRINT  "Chronic  Bullous  Lesions" 
color  normal,  bground 

locate  6, 19:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  6,  21:PRINT  "1.  ";chr$(34);"Desquamative  gingivitis";chr$(34) 
locate  ,  19:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  7, 21:PRINT  "2.  Benign  mucous  membrane  pemphigoid" 
locate  ,  19:color  astrsk,  bground:print  ”*";:color  nonnal,  bground 
locate  8, 21 -.PRINT  "3.  Bullous  pemphigoid" 
locate  ,  19:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  9, 21:PRINT  "4.  Pemphigus  vulgaris" 
locate  ,  19:color  astrsk,  bgroundrprint  "*";:color  nonnal,  bground 
locate  10,  21:PRINT  "5.  Familial  benign  chronic  pemphigus" 
locate  ,  19:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  11,  21:PRINT  "6.  Bullous  lichen  planus" 
locate  ,  19:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  12,  21:PRINT  "7.  Epidermolysis  bullosa" 
locate  ,  19:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  13,  21:PRINT  "8.  Acrodermatitis  enteropathica" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

elseif  sh=5  then 
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27650  color  highlight,  bground 

locate  4,  33:PRINT  "Acute  Ulcers" 
color  normal,  bground 

locate  6,  13:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  6,  15:PRINT  "1.  All  acute  vesicular  and  bullous  diseases" 
locate  7, 15:PRINT  "2.  Apthous  stomatitis" 
locate  8, 15:PRINT  "3.  Syphilis  (chancre)" 
locate  9, 15:PRINT  "4.  Gonorrhea 

locate  10,  15:PRINT  "5.  Necrotizing  ulcerative  gingivitis  (NUG,  ANUG)" 
locate  11,  15:PRINT  "6.  Traumatic  ulcer" 
locate  12, 15:PRINT  "7.  Chemical  bum" 
locate  13,  15:PRINT  "8.  Thermal  bum" 
locate  14,  15:PRINT  "9.  Herpetic  gingivostomatitis" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sh=6  then 
sh6: 

color  highlight,  bground 

locate  4,  32:PRINT  "Chronic  Ulcers" 

color  normal,  bground 

locate  6,  18:PRINT  "1.  All  chronic  bullous  lesions" 

locate  7,  18:PRINT  "2.  Large  apthous  ulcer" 

locate  8,  18:PRINT  "3.  Periadenitis  mucosa  necrotica  recurrens" 

locate  9,  18:PRINT  "4.  Syphilis  (gumma) 

locate  ,  16:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  10,  18:PRINT"5.  Granulomatous  mycotic  infections" 

locate  ,  16:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  11,18:PRINT  ”6.  Malignancy" 

locate  12,  18:PRINT'7.  Keratoacanthoma" 

locate  ,  16:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  13,  18:PRINT"8.  Blood  dyscrasias" 

locate  ,  16:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  14,  18:PRINT"9.  Noma  (rare) 

locate  ,  16:color  astrsk,  bground:print  "*”;:color  normal,  bground 
locate  15,  18:PRINT  "10.  Behcet’s  syndrome" 
page=l:npages=2 
call  diffpressret 
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if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-2,  endc-1,  scrollines,  attrib) 

color  highlight,  bground 

locate  4, 32:PRINT  "Chronic  Ulcers" 

color  normal,  bground 

locate  7, 21:color  astrsk,  bgroundrprint  "*";:coIor  normal,  bground 

locate  7, 23:PRINT  "11.  Midline  lethal  granuloma" 

locate  ,  21:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  8, 23:PRINT  "12.  Wegener’s  granulomatosis" 

locate  ,  21:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  9,  23:PRINT  "13.  Tuberculosis" 

locate  10, 23:PRINT  "14.  Draining  fistula/parulis" 

locate  11,  23:PRINT  "15.  Lupus  erythematosus" 

locate  ,  21:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  12, 23:PRINT  "16.  Sarcoidosis" 

locate  ,  21:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  13,  23:PRINT  "17.  Necrotizing  sialometaplasia" 
locate  14, 23:PRINT  "18.  Warty  dyskeratoma" 
locate  ,  21rcolor  astrsk,  bgroundrprint  ”*";:color  normal,  bground 
locate  15, 23:PRINT  "19.  Traumatic  ulcer" 
page=2:npages=2 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
elseif  ans=73  then 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-2,  endc-1,  scrollines,  attrib) 
goto  sh6 
end  if 

elseif  si=l  then 

28070  color  highlight,  bground 

locate  4,  17:PRINT  "Small  Firm  Non-hemorrhagic  Lobulated  lesions" 

color  normal,  bground 

locate  6,  20:PRINT"1.  Papilloma" 

locate  ,  18:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  7,  20:PRINT  "2.  Verruca  vulgaris" 
locate  8,  20.PRINT  ”3.  Lingual  tonsil" 
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locate  9, 20:PRINT  "4.  Folate  papilla” 

locate  10, 20:PRINT  "5.  Median  rhomboid  glossitis" 

locate  1 1 , 20:PRINT  "6.  Keratoacanthoma" 

locate  12, 20:PRINT  ”7.  Cutaneous  horn" 

locate  13,20:PRINT”8.  Nevi" 

locate  ,  18:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  14, 20:PRINT  "9.  Basal  cell  carcinoma" 
locate  15, 20:PRINT  "10.  Neurofibroma" 
locate  16, 20:PRINT  "11.  Circum vallate  papilla  (taste  bud)" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  si=2  then 

28240  color  highlight,  bground 

locate  4,  14:PRINT  "Extensive  Firm  Non-hemorrhagic  Lobulated  Lesions" 
color  normal,  bground 

locate  6,  20:PRINT  "1.  Gingival  fibromatoses  (see  gingiva)" 
locate  7, 20:PRINT  "2.  Amyloidosis” 
locate  8,  20:PRINT  "3.  Fissured  tongue" 
locate  9, 20:PRINT  "4.  Macroglossia" 
locate  10,  20:PRINT  ”5.  Buccal  fat  pads" 
locate  1 1,  20:PRINT  "6.  Tori" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  si=3  then 

28360  color  highlight,  bground 

locate  4,  21:PRINT  "Single  Firm  Non-hemorrhagic  Nodules" 

color  normal,  bground 

locate  6,  22:PRINT  "1 .  Irritation  fibroma" 

locate  7,  22:PRINT  ”2.  Epulis  fissuratum" 

locate  8,  22:PRINT  "3.  Peripheral  ossifying  fibroma" 
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locate  9, 22:PRINT  "4.  Lingual  thyroid” 
locate  10, 22:PRINT  "5.  Granular  cell  myoblastoma" 
locate  11, 22:PRINT  "6.  Fibrolipoma" 
locate  12, 22:PRINT  "7.  Benign  neural  tumors" 
locate  13, 22:PRINT  "8.  Benign  salivary  tumors" 
locate  14, 22:PRINT  "9.  Choristoma/hamartoma" 
locate  15, 22:PRINT  "10.  Extraosseous  odontogenic  tumor" 
locate  16, 22:PRINT  "11.  Rhabdomyoma" 
locate  17, 22:PRINT  "12.  Oral-facial-digital  syndrome" 
locate  1 8, 22:PRINT "  1 3.  Lymph  node" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

elseif  si=4  then 

si4: 

color  highlight,  bground 

locate  4, 20:PRINT  "Multiple  Firm  Non-hemorrhagic  Nodules" 
color  normal,  bground 

locate  6, 20:PRINT  "1.  Papillaiy  hyperplasia  of  the  palate" 

locate  7, 20:PRINT  "2.  Papillomatosis" 

locate  8,  20:PRINT  "3.  Hairy  tongue" 

locate  9, 20:PRINT  "4.  Accessory  tonsillar  tissue" 

locate  10,  20:PR1NT  "5.  Focal  epithelial  hyperplasia" 

locate  1 1, 20:PRINT  "6.  Neurofibromatosis" 

locate  12, 20:PRINT  "7.  Multiple  mucosal  neuromas  syndrome" 

locate  13, 20:PRINT  "8.  Nicotine  stomatitis  (palate)" 

locate  14,  20:PRINT  "9.  Amyloidosis" 

locate  ,  18:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  15,  20:PRINT  "10.  Sarcoidosis" 

locate  ,  18:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  16, 20:PRINT  "11.  Verruca  vulgaris,  multiple  lesions" 


page=l:npages=2 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
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end  if 


CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-2,  endc-1,  scrollines,  attrib) 
color  highlight,  bground 

locate  4, 20:PRINT  "Multiple  Firm  Non-hemorrhagic  Nodules" 
color  normal,  bground 

locate  6, 21:PRINT  "12.  Focal  dermal  hypoplasia  syndrome" 
locate  7, 21  :PRINT  "13.  Darier’s  disease" 
locate  ,  19:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  8, 21:PRINT  "14.  Acanthosis  nigricans" 
locate  ,  19:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  9, 21:PRINT  "15.  Crohn’s  disease" 
locate  10, 21:PRINT  "16.  Oral- facial-digital  syndrome" 
locate  1 1, 21:PRINT  "17.  Lipoid  proteinosis" 
locate  ,  19:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  12,  21:PRINT  "18.  Pyostomatitis  vegetans" 
locate  13,  21:PRINT  "19.  Pemphigus  vegetans" 
locate  14, 21:PRINT  "20.  Condyloma  acuminatum" 
locate  15,  21:PRINT  ”21.  Fordyce  granules" 
page=2:npages=2 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
elseif  ans=73  then 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-2,  endc-1,  scrollines,  attrib) 
goto  si4 
end  if 

elseif  si=5  then 

28840  color  highlight,  bground 

locate  4,  25:PRINT  "Single  Bony  Lumps  or  Nodules" 
color  normal,  bground 

locate  ,  18:PRINT  "1.  Torus  palatinus  (may  appear  lobulated)" 
locate  ,  18:PRINT  "2.  Torus  mandibularis" 
locate  ,  18:PRINT  "3.  Osteoma/exostosis" 
locate  ,  16:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  ,  18:PRINT  "4.  Central  expanding  bone  or  odontogenic  tumor" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
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goto  softmenu 
end  if 


elseif  si=6  then 

28940  color  highlight,  bground 

locate  4, 14:PRINT  "Multiple  or  Extensive  Bony  Enlargements  or  Nodules" 

color  normal,  bground 
locate  6, 10:PRINT  "1.  Torus  mandibularis" 
locate  7,  lO'.PRINT  "2.  Torus  palatinus  (may  appear  lobulated)" 
locate  ,  8:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  8, 10:PRINT  "3.  Multiple  osteomas/Gardner’s  syndrome" 
locate  9, 10:PRINT  "4.  Buccal  exostoses" 
locate  ,  8:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  10,  lO.'PRINT  "5.  Central  expanding  bone  or  odontogenic  tumor" 
locate  11, 10:PRINT"6.  Fibrous  dysplasia" 
locate  ,  8:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  12, 10:PRINT  "7.  Paget’s  disease  of  bone” 
locate  13, 10:PRINT  "8.  Cherubism" 
locate  14,  10.PRINT  "9.  Acromegaly/gigantism" 
locate  15, 10:PRINT  "10.  Hemifacial  hypertrophy" 
locate  16, 10:PRINT  "11.  Generalized  cortical  hyperostosis  (Van  Buchem 
disease)" 

page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 

elseif  sj=l  then 

29110  color  highlight,  bground 

locate  4,  34:PRINT  "Macroglossia" 
color  normal,  bground 

locate  6, 21:PRINT  "1.  Beckwith’s  hypoglycemic  syndrome" 
locate  7,  21:PRINT  "2.  Melkersson-Rosenthal  syndrome" 
locate  8,  21:PRINT  "3.  Multiple  mucosal  neuromas  syndrome" 
locate  9,  21:PRINT  "4.  Isolated  macroglossia" 
locate  10,21  :PRINT  "5.  Amyloidosis" 
locate  1 1,  21:PRINT  "6.  Neurofibromatosis" 
locate  12,  21 -.PRINT  "7.  Acromegaly/cretinism" 
locate  13,  21  .PRINT  "8.  Pellagra" 


DENTAL  Programmer’ s  Manual  A-149 


locate  14,  21:PRINT  "9.  Thiamine  (Bl)  deficiency" 
locate  15,  21:PRINT  "10.  Adult  hypothyroidism" 
locate  16, 21:PRINT  "11.  Hemifacial  hypertrophy" 
locate  17, 21:PRINT  "12.  Angiomas" 
locate  18,  21:PRINT  "13.  Xerostomia" 

locate  ,  19:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  19, 21:PRINT  "14.  Diabetes  mellitus  (uncontrolled)" 
locate  ,  19:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  20, 21:PRINT  "15.  Other  tumors" 
locate  21, 21:PRINT  "16.  Lymphangioma" 
locate  22, 21:PRINT  "17.  Hemangioma" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sj=2  then 

29340  color  highlight,  bground 

locate  4,  33:PRINT  "Microglossia":color  normal,  bground 
locate  6,  20:color  astrsk,  bground '.print  "*";-.color  normal,  bground 
locate  6, 22:PPJNT  "1.  Progressive  muscular  atrophy" 
locate  7, 22:PRINT  "2.  Oral-facial-digital  syndrome" 
locate  8, 22:PRINT  "3.  Lingual  carcinoma,  post-surgery" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sj=3  then 

29430  color  highlight,  bground 
locate  4,  36:PRINT  "Clefts" 
color  normal,  bground 
locate  6,  23:PRINT  "1.  Idiopathic  cleft" 
locate  7,  23:PRINT  "2.  With  cleft  palate" 
locate  8,  23:PRINT  "3.  With  median  cleft  of  mandible" 
locate  9,  23:PRINT  "4.  Oral-facial-digital  syndrome" 
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page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sj=4  then 

29530  color  highlight,  bground 

locate  4,  31:PRINT  "Fissured  Tongue" 

color  normal,  bground 

locate  6,  21:PRINT  "1.  Inherited" 

locate  7,  21:PRINT  "2.  Associated  with  geographic  tongue" 
locate  8, 21:PRINT  "3.  Melkersson-Rosenthal  syndrome" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sj=5  then 

29620  color  highlight,  bground 

locate  4, 29.PRINT  "Supernumerary  Tongue" 
color  normal,  bground 

locate  6, 17:PRINT  "1.  First  and  second  branchial  arch  syndrome" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sj=6  then 

29690  color  highlight,  bground 

locate  4,  32::PRINT  "Smooth  Tongue" 
color  normal,  bground 

locate  6,  1 1:PRINT  "1.  Vitamin  B  complex  deficiency" 
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locate  7,11  :PRINT  "2.  Pernicious  anemia" 
locate  ,  9:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  8, 11:PRINT  "3.  Diabetes  mellitus" 
locate  9,  11:PRINT  "4.  Anxiety  with  hypertension" 
locate  ,  9:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  10,  11:PRINT  "5.  Cardiac  decompensation" 
locate  ,  9:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  11,  11:PR1NT  "6.  Plummer- Vinson  syndrome" 
locate  12, 11:PRINT  "7.  Xerostomia" 
locate  13, 1 1:PRINT  "8.  Congenital  absence  of  papillae" 
locate  14, 11:PRINT"9.  Geographic  tongue" 
locate  15, 1 1:PRINT  "10.  Median  rhomboid  glossitis" 
locate  ,  9:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  16,  1 1:PRINT  "11.  Epidermolysis  bullosa/other  vesiculo-bullous 
lesions" 

locate  17,  1 1:PRINT  "12.  Other  anemias" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sj=7  then 

29870  color  highlight,  bground 

locate  4,  24:PRINT  "Glossodynia  (Pain  in  Tongue)" 
color  normal,  bground 

locate  6,  19:PRINT  "1.  Vitamin  B  complex  deficiency" 

locate  7,  19:PR1NT  "2.  Pernicious  anemia" 

locate  8,  19:PRINT  "3.  Iron  deficiency  anemia" 

locate  9,  19:PRINT  "4.  Diabetes  mellitus  (uncontrolled)" 

locate  10,  19:PRINT  "5.  Local  irritants/habits" 

locate  ,  17:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  11,  19:PRINT  "6.  Drug  reactions" 

locate  12,  19:PRINT  "7.  Contact  allergy" 

locate  13,  19:PRINT  "8.  Excessive  smoking,  alcohol,  or  spices" 

locate  14,  19:PRINT  "9.  Sjogren’s  syndrome" 

locate  15,  19:PRINT  "10.  Psychosomatic" 

locate  16,  19:PRINT  "11.  Inflamed  lingual  tonsil" 

locate  ,  17:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  17,  19:PRINT  "12.  Sprue" 

locate  18,  19:PRINT  "13.  Hairy  tongue" 
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locate  19, 19:PRINT  "14.  Decreased  intermaxillary  space” 
locate  20, 19:PRJNT  "15.  Temporomandibular  joint  dysfunction" 
locate  21, 19:PRINT  "16.  Candidiasis" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sk=l  then 

30090  color  highlight,  bground 

locate  4,  25:PRINT  "Acute  Parotid- area  Swellings" 
color  normal,  bground 

locate  6,  26:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  6,  28:PRINT "  1.  Mumps/other  parotitis" 
locate  ,  26:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  7, 28:PRINT "  2.  Sialolithiasis" 

locate  ,  26:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  8,  28:PRINT  "  3.  Drug  reactions" 

locate  ,  26:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  9,  28:PRINT "  4.  Mikulicz’s  syndrome" 
locate  ,  26:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  10,  28:PRINT  "  5.  Salivary  malignancy" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sk=2  then 

30200  color  highlight,  bground 

locate  4,  24:PRINT  "Chronic  Parotid-area  Swellings" 
color  normal,  bground 

locate  6,  22:PRINT  "1.  Recurrent  subacute  parotitis" 
locate  7,  22:PRINT  "2.  Chronic  ductal  obstruction" 
locate  8,  22:PRINT  "3.  Benign  salivary  tumor" 
locate  9,  22:PRINT  "4.  Sjogren’s  syndrome" 
locate  10,  22:PRINT  "5.  Diabetes  mellitus" 
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locate  11, 22:PRINT  "6.  Benign  lymphoepithelial  lesion" 
locate  12,  22:PRINT  "7.  Chronic  alcoholism" 
page=l:npages=l 
call  diffpressret 
if  ms-61  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sk=3  then 

30330  color  highlight,  bground 

locate  4, 19:PR1NT  "Acute  Discrete  Nodules,  Non-parotid  Area" 
color  normal,  bground 

locate  6,  21:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  6, 23:PRINT  "1.  Acute  lymphadenitis" 
locate  ,  21:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  7,  23:PRINT  "2.  Infectious  mononucleosis" 
locate  ,  21:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  8, 23:PRINT  "3.  Non-Hodgkins  lymphomas" 
locate  ,  21:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  9,  23:PRINT  "4.  Hodgkin’s  disease" 
locate  ,  21:color  astrsk,  bground’.print  "*”;:color  normal,  bground 
locate  10,  23:PRINT  "5.  Sialadenitis  (submandibular)" 
locate  ,  21  :color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  1 1, 23:PRINT  "6.  Metastatic  tumors" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sk=4  then 

30450  color  highlight,  bground 

locate  4,  18:PRINT  "Chronic  Discrete  Nodules,  Non-parotid  area":  color 
normal,  bground 

locate  6,  18:PRINT  "1.  Lipoma" 
locate  7,  18:PRINT"2.  Sebaceous  cyst" 
locate  8,  18:PRINT  "3.  Branchial  cleft  cyst" 
locate  9,  18:PRINT  "4.  Thyroglossal  duct  cyst" 
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locate  10, 18:PRINT"5.  Epidermoid/dermoid  cyst" 

locate  1 1, 18.PRINT  "6.  Thyroid  enlargement" 

locate  12, 18:PRINT"7.  Parathyroid  enlargement" 

locate  ,  16:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 

locate  13, 18:PRINT  "8.  Carotid  body  tumor" 

locate  ,  16:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  14, 18:PRENT  "9.  Benign  salivary  tumor  (submandibular)" 

locate  ,  16:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  15, 18:PRINT  "10.  Tuberculosis" 

locate  ,  16:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  16, 18:PRINT  "1 1.  Sarcoidosis” 

locate  ,  16:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  17, 18:PRINT  "12.  Benign  mesenchymal  tumors" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sk=5  then 

30630  color  highlight,  bground 

locate  4, 13:PRINT  "Acute  Extensive  Diffuse  Swellings,  Non-parotid 
Area" 

color  normal,  bground 

locate  6,  20:color  astrsk,  bgroundtprint  ”*";:color  normal,  bground 
locate  6,  22:PRINT  "1.  Cellulitis" 

locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  7,  22:PR1NT  "2.  Ludwig’s  angina" 
locate  8,  22:PRINT  "3.  Ranula" 

locate  ,  20:color  astrsk,  bgroundtprint  "*";:color  normal,  bground 

locate  9,  22:PRINT  "4.  Sialolithiasis  (submandibular)" 

locate  10, 22:PRINT  "5.  Cat-scratch  disease" 

locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  1 1,  22:PRINT  "6.  Lymphomas" 

locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  12,  22:PRINT  "7.  Metastatic  tumors" 

locate  ,  20:color  astrsk,  bground:print  "*";:color  normal,  bground 

locate  13,  22.PRJNT  "8.  Primary  cervical  malignancies" 

page=l:npages=l 

call  diffpressret 

if  ans=67  then 
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goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 


elseif  sk=6  then 

30770  color  highlight,  bground 

locate  4, 12:PRINT  "Chronic  Extensive  Diffuse  Swellings,  Non-parotid 
Area" 

color  normal,  bground 

locate  6, 18:PRINT  "1.  Sialolithiasis  (submandibular)" 
locate  ,  16:color  astrsk,  bground:print  "*";:color  normal,  bground 
locate  7,  18:PRINT  "2.  Benign  salivary  tumor" 
locate  ,  16:color  astrsk,  bgroundrprint  "*";:color  normal,  bground 
locate  8,  18:PRINT  "3.  Cushing’s  syndrome  (buffalo  hump)" 
locate  9,  18:PRINT  "4.  Benign  hereditary  cervical  lipomatosis" 
page=l:npages=l 
call  diffpressret 
if  ans=67  then 
goto  mainmenu 
elseif  ans=68  then 
goto  softmenu 
end  if 
end  if 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  box  (begr,  begc,  endr,  endc) 
locate  25,  l:print  space$(80); 

locate  8,  3:PRINT  "The  preceding  differential  diagnosis  should  be  of 
assistance.  You  should  be" 

locate  9,  3:PRINT  "able  to  narrow  this  list  considerably  by  using  your 
knowledge,  impressions, " 

locate  10,  3:PRINT  "and  other  references." 

locate  12,  3:PRINT  "Remember,  diagnoses  in  the  differential  list  that 
have  an  asterisk  ("; 

color  astrsk,  bground:print 
color  normal,  bground:print 

locate  13,  3:PRINT  "beside  them  should  be  investigated  as  possible 
life-threatening  or" 

locate  14,  3:PRINT  "mission-three  rening  situations." 

LOCATE  25,  liprint  "Press  RETURN  to  continue."; 
x$=input$(l) 

goto  printdgagain: 
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mammenu: 


REM  Clear  screen,  draw  box  then  go  back  to  main  program. 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
call  box  (begr,  begc,  endr,  endc) 
chain  "dental" 

endit: 

REM  Display  last  page. 

CALL  SCROLLUP  (BEGR+1,  BEGC+1,  ENDR-1,  endc-1,  scrollines,  attrib) 
locate  5,  10:PRINT  "Thank  you.  If  you  have  any  questions  concerning 
this  program, " 

locate  6, 10:print  "please  contact:" 
locate  9,  10.PRINT  "Commanding  Officer" 

locate  10, 10:PRINT  "Naval  Submarine  Medical  Research  Laboratory" 

locate  11, 10:PRINT  "Naval  Submarine  Base  New  London" 

locate  12,  10.PRINT  "Groton,  Connecticut  06349-5900" 

locate  14,  10:PRJNT  "(203)  449-2523  commercial" 

locate  15, 10.PRINT "  8-241-2523  autovon" 

locate  23, 1 , 1  ’turn  cursor  back  on 

END 

Subroutine  DIFFPRESSRET 
Called  from:  DIFF 

This  routine  is  called  from  DIFF  after  "Press  RETURN  to  continue"  is 
displayed  at  the  bottom  of  the  screen.  Along  with  the  RETURN  key,  it 
also  allows  the  user  to  press  F9  for  the  Main  Menu,  F10  for  the  Soft 
Tissue  Lesions  Menu,  F7  for  Term  Definitions,  and  PgUp  and  PgDn  to  view 
the  different  pages  of  the  differential  diagnosis. 

sub  diffpressret  static 

shared  page,  npages,  ans,  normal,  bground,  quescolor 

p$=str$(page) 

np$=str$(npages) 

color  quescolor,  bground.LOCATE  22,  66:print"(Page";p$;"  of';np$;")"; 
color  normal,  bground 

ans=0 
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while  ans=0 


getkey  1 :  ’  clear  keyboard  buffer 

z$=inkey$ 
if  z$""  then 
goto  getkey  1 
end  if 

getkey2: 
z$=inkey$ 
if  z$=’”’  then 
goto  getkey2 
end  if 

if  z$=chr$(13)  then  '  ***  RETURN /ENTER 
ans=13 

elseif  len(z$)=2  then 
z$=right$(z$,  1) 

ir  z$=chi$(67)  then  ’***  F9  main  menu 
ans=67 

lseif  z$=chr$(68)  then  '***  F10  sub  menu 
ans=68 

eiseif  z$=chr$(65)  then  ’***  F7  definitions 
call  defxnitionroutine2 

elseif  z$=chr$(73)  and  page=2  then  '  ***  PgUp 
ans=73 

elseif  z$=chr$(81)  then  ’***  PgDn 
ans=81 
end  if 
'  id  if 
wt.id 
end  i  ab 
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Appendix  A 
Program  Listings 

DENTCOMM.BAS 

REM  common  statements  used  by  DENTAL,  DUFF,  DEFRTNS,  and  DENTS  UBS. 
COMMON  SHARED  normal,  bground,  ssn$,  age$,  response(),  z() 

COMMON  SHARED  mon$,  whercfrom$,  option$(),  opline(),longest,  numops 
COMMON  SHARED  qrow,  qcol,  oprow,  opcol,  ptrcol,  ptr$,  ptrcolor,  blanks2$ 
COMMON  SHAREDquescolor,  ans,  mmenu,  softmenu,  respbar,  resplettr,  ssnbox 
COMMON  SHARED  realcase,  corprespO,  other$ 

COMMON  SHARED  dindx(),  item$(),  disease$(),  disindx(),  defkeyline,  defkeylettr 
COMMON  SHARED  selectlf,  deflf,  defls,  select2s,  select2f,  def2f,  def2s 
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Appendix  A 
Program  Listings 


WINDCOMM.BAS 

REM  common  statements  used  by  window  routines. 

COMMON  SHARED  /WIND1/  WINDrow(),  WINDcol(),  WINDheightO,  WINDwidth(), 
WINDheader$() 

COMMON  SHARED  /WIND2/  WINDscrattO,  WINDframatt(),  WIND%(),  WINDcurrent 

COMMON  SHARED  /WIND3/  WINDrowptr(),  WINDcolptr(),  WINDcurrentrow, 
WINDcurrentcol 
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Utility  File  Listings 


DEFBLD.BAS 


REM  After  this  prog  creates  DEF.RND,  you  must  edit  the  index  (DEF.IDX)  to 
REM  take  care  of  the  words  with  slashes,  (separate  the  words  and  have 
REM  them  both  reference  the  same  record.  Make  sure  they  stay  in  alphabetical  order.) 
REM  This  version  creates  a  random  access  file  with  60  chars  per  record. 

REM  Each  definition  is  terminated  with  a  "I"  ( ASCII  124). 

dim  word$(100),def$(100),dindx(100,2) 

open  "r",#l,"def.md",60 

open  "def.idx"  for  output  as  #2 

field#  1, 60  as  a$ 

linelimit=60 

els 

for  x=l  to  73 
read  word$(x) 
next  x 
r=l 

for  x=l  to  73 
read  def$(x) 
def$(x)=def$(x)+"." 

Iinecount=0 

dindx(x,l)=r 

while  len(def$(x))  >  linelimit 
b=linelimit 

while  mid$(def$(x),b,l)  <>  "  " 
b=b-l 
wend 

lset  a$=left$(def$(x),b) 

put  #l,r 

r=r+l 

def$(x)=space$(5)+right$(def$(x),len(def$(x))-b) 
linecount=linecount+ 1 
wend 

lset  a$=def$(x) 
put  #l,r 
r=r+l 

linecount=linecount+ 1 
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dindx(x,2)=linecount 


next  x 

for  x=l  to  73 

print#2,dindx(x,l),  dindx(x,2) 
print#2,word$(x) 
next  x 
close 

data  "Abscess", "Acute", "Alveolar  Bone","Anomaly","Apical" 

data  "Atrophy", "Avulsed","Blunted", "Buccal", "BuUa","CelluUtis" 

data"Chronic","Cleft", "Crepitus", "Cyst","Dentin","Desquamation" 

data  "Diffuse","Diplopia","Discrete","Enamel", "Endodontic" 

data  "Enopthalmia","Eroded","Exophytic","Exopthalmia", "Fissured" 

data  "Fluctuant","Generalized", "Gingiva", "Glossodynia", "Hemorrhagic" 

data  "Hyperplastic", "Infraorbital  Rim’V'Intercanthal  Distance" 

data  "Irreversible  Pulpitis", "Keratotic’V’Lobulated", "Localized" 

data  "Lingual","Macroglossia","Malaise","Mandibular", "Maxillary" 

data  "Membranous", "Microglossia","Mobility","Mucosa","Muscles  of  Mastication" 

data  "Myofacial","Necrotic/Necrotizing","Nodules", "Occlusion/Occlusal  Surface" 

data  "Papillary","Parotid-area","Periodontal/Periodontic" 

data  "Periodontitis", "Preauricular","Probing  Depth","Pulp" 

data  "Pulpitis","Purulence", "Racial  Pigmentation", "Restoration" 

data  "Reversible  Pulpitis","Sequestrum", "Sinusitis", "Spontaneous" 

data  "Supernumerary ’’/’Temporomandibular  Joint  (TMJ)", "Ulcers/Ulcerated" 

data  "Vesicular", "Zygomatic  arch" 

data  "Abscess:  Localized  accumulation  of  purulent  material  or  pus,  usually  acute" 
data  "Acute:  Sharp;  having  a  short  and  relatively  severe  course" 
data  "Alveolar  Bone:  The  bone  of  the  mandible  or  maxilla  that  supports  teeth" 
data  "Anomaly:  Deviation  from  normal" 

data  "Apical:  Referring  to  the  apex  of  a  tooth;  end  of  the  tooth  opposite  the  crown" 

data  "Atrophy:  A  wasting  away  or  diminution  in  the  size  of  the  tissue/organ" 

data  "Avulsed:  Separated  or  detached  forcibly" 

data  "Blunted:  Flattened  with  loss  of  scalloped  (pointed)  shape" 

data  "Buccal:  Pertaining  to  the  cheeks  or  the  cheek  side" 

data  "Bulla:  A  large  blister  or  cutaneous  vesicle  filled  with  serous  fluid" 

data  "Cellulitis:  Diffuse,  usually  subcutaneous  spreading  inflammation  of  connective  tissue" 

data  "Chronic:  Long-standing;  not  acute" 

data  "Cleft:  A  longitudinal  opening  or  fissure" 

data  "Crepitus:  Cracking  or  grating  sound" 

data  "Cyst:  A  sac-like  structure  filled  with  a  liquid  or  semisolid  substance" 
data  "Dentin:  The  light-yellowish  tooth  substance  that  surrounds  the  pulp  and  is  covered 
by  enamel" 

data  "Desquamation:  The  shedding  of  epithelial  elements/cells  in  scales  or  sheets  (surface 
layers  of  tissue)" 
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data  "Diffuse:  Not  definitely  limited  or  localized" 
data  "Diplopia:  Double  vision" 
data  "Discrete:  Separate  or  distinct" 

data  "Enamel:  The  white,  hard  substance  that  covers  and  protects  the  dentin  of  the  crowns 
of  teeth" 

data  "Endodontic:  Pertaining  to  the  pulp  of  the  tooth" 
data  "Enopthalmia:  Retraction  of  the  eye  into  the  orbit" 
data  "Eroded:  Worn  away;  destroyed  over  time" 
data  "Exophytic:  Outwardly  growing" 
data  "Exopthalmia:  Abnormal  protrusion  of  the  eye" 
data  "Fissured:  Having  clefts  or  grooves" 

data  "Fluctuant:  Having  a  wave-like  motion  or  the  sensation  of  being  fluid-filled" 
data  "Generalized:  Throughout;  not  localized" 

data  "Gingiva:  Gum  tissue;  keratinized  mucosal  tissue  that  surrounds  the  necks  of  the  teeth" 

data  "Glossodynia:  Pain  in  the  tongue" 

data  "Hemorrhagic:  Pertaining  to  or  characterized  by  bleeding" 

data  "Hyperplastic:  Pertaining  to  an  abnormal  multiplication  or  increase  in  the  number  of 
normal  cells  in  normal  arrangement  in  a  tissue" 

data  "Infraorbital  Rim:  Bony  rim  palpable  just  below  the  eye" 
data  "Intercanthal  Distance:  Distance  between  the  medial  comers  of  the  eye" 
data  "Irreversible  Pulpitis:  A  state  of  pulpal  inflammation  in  which  the  pulp  does  not  have 
the  potential  to  return  to  a  state  of  health" 

data  "Keratotic:  Having  a  homy/keratinized/somewhat  fibrotic  nature;  usually  whitish  in 
appearance;  cannot  be  rubbed-off ' 

data  "Lobulated:  Made  up  of  or  divided  into  lobules" 
data  "Localized:  Restricted  to  a  limited  region;  not  generalized" 
data  "Lingual:  Pertaining  to  the  tongue  or  tongue  side" 
data  "Macroglossia:  Enlarged  tongue" 

data  "Malaise:  Unlocalized  body  uneasiness,  debility,  or  discomfort" 
data  "Mandibular:  Pertaining  to  the  lower  jaw  or  mandible" 
data  "Maxillary:  Pertaining  to  the  upper  jaw  or  maxilla" 

data  "Membranous:  Pertaining  to  a  membrane;  pertaining  to  a  thin  layer  of  tissue  which 
covers  a  surface" 

data  "Microglossia:  Under  size  of  the  tongue" 

data  "Mobility:  (Dental)  pertaining  to  an  increased  buccal/lingual  (sideways)  or  vertical 
movement  of  the  teeth" 

data  "Mucosa:  Mucous  membrane;  (oral)  the  tissue  lining  inside  the  mouth" 
data  "Muscles  of  Mastication:  Primarily  the  masseter,  temporalis,  medial  pterygoid  and 
lateral  pterygoid  muscles" 

data  "Myofacial:  Referring  to  muscles  of  the  face" 

data  "Necrotic/Necrotizing:  Having  characteristics  of  necrosis  or  non-vitality" 
data  "Nodules:  A  small  boss  or  node  which  is  solid  and  detectable  by  touch" 
data  "Occlusion/Occlusal  Surface:  Pertaining  to  the  bite  or  interdigitation  of  the  teeth;  the 
biting  surface" 
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data  "Papillary:  Pertaining  to  or  resembling  small  nipple-shaped  projections  or  elevations" 
data  "Parotid-area:  Pertaining  to  the  area  of  the  parotid  salivary  gland;  anterior  and  inferior 
to  the  ear" 

data  "Periodontal/Periodontic:  Pertaining  to  the  supporting  structures  of  teeth  (i.e.  gingiva, 
bone,  periodontal  ligament,  and  cementum)" 

data  "Periodontitis:  Inflammation  of  the  supporting  structures  of  the  teeth” 
data  "Preauricular:  In  front  of  the  ear" 

data  "Probing  Depth:  Depth  of  a  periodontal  pocket/sulcus  measured  in  mm  from  the 
gingival  margin  to  the  base  of  the  pocket/sulcus" 

data  "Pulp:  The  vascular,  nervous,  and  connective  tissue  contained  within  the  pulp  chamber 
in  the  center  of  the  tooth" 

data  "Pulpitis:  Inflammation  of  the  pulp” 
data  "Purulence:  The  condition  of  having  or  containing  pus" 
data  "Racial  Pigmentation:  (Dental)  normal  pigmentation  of  the  mucosa/gingiva; 
characterized  by  a  diffuse  generalized  appearance;  more  commonly  found  in  dark-skinned 
persons" 

data  "Restoration:  A  dental  filling" 

data  "Reversible  Pulpitis:  A  state  of  pulpal  inflammation  in  which  the  pulp  has  the  potential 
to  return  to  a  state  of  health" 

data  "Sequestrum:  That  which  is  sequestered  or  given  off;  often  refers  to  a  small  fragment 
of  non-vital  bone" 

data  "Sinusitis:  Inflammation  of  a  sinus  or  sinuses" 

data  "Spontaneous:  Occurring  for  no  particular  reason  or  stimulus" 

data  "Supernumerary:  Extra;  above  the  normal  number" 

data  "Temporomandibular  Joint  (TMJ):  The  joint(s)  which  connects  the  mandible  to  the 
temporal  bone" 

data  "Ulcers/Ulcerated:  A  loss  of  substance  on  a  cutaneous  or  mucous  surface  causing 
gradual  disintegration  and  necrosis  of  the  tissues" 

data  "Vesicular:  Pertaining  to  small  blisters  or  serous-filled  elevations" 

data  "Zygomatic  arch:  The  bony  arch  formed  by  zygomatic  bone  (malar/cheek  bone)" 
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Utility  File  Listings 


DISDFBLD.BAS 


REM  This  prog  creates  DISDEF.IDX,  DISDEF.RND  FROM  DXDEF.TXT. 


dim  def$(  1 00),dindx(  1 00,2),  word$(  1 00) 

open  "r",#l,"disdef.md",60 

open  "disdef.idx"  for  output  as  #2 

open  "dxdef.txt"  for  input  as  #3 

field#l,  60  as  a$ 

linelimit=60 

els 

r=l  :linecount=0:wordcount=0 
while  not  eof(3) 
line  input  #3,  txt$ 
txt$=left$(txt$,Iinelimit) 
print  txt$ 

wordcoun  t=wordcoun  t+ 1 
dindx(wordcount,  1  )=r 
b=instr(txt$,":") 
b=b-l  ’get  rid  of: 
word$(wordcount)=left$(txt$,b) 
while  txt$  " — " 

Iset  a$=txt$ 

put#l,r 

r=r+l 

linecount=linecount+ 1 
line  input  #3,  txt$ 
txt$=Ieft$(txt$,linelimit) 
print  txt$ 
wend 

dindx(wordcount,2)=hnecount 

linecount=0 

wend 

print  wordcount 
for  x=I  to  wordcount 
print#2,dindx(x,l),  dindx(x,2) 
print  word$(x) 
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print#2,word$(x) 
next  x 
close 
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Utility  File  Listings 


TREATBLD.BAS 


REM  Read  a  text  file  (trtmts.txt)  and  create  an  index  of  the  first  record  numfor  each  treatment 
plan. 

20  NM  =  35 

25  OPEN  ’’R",#l,"trtmts.md",75 
30  FIELD  #1,75  AS  A$ 
open  "trtmts.txt"  for  input  as  #2 
r=l 

35  FOR  1  =  0  TO  NM 
print  "treat#";i;"  rec#";r 
par$="" 


45  line  input  #2,  TX$ 
if  tx$=" — "  then  60 
par$=par$+tx$+" " 
goto  45 

60  REM  break  up  lines 
limit=75 

while  len(par$)limit 
b=limit+l 

while  mid$(par$,b,l)  <>  "  " 
b=b-l 
wend 

lset  a$=left$(par$,b) 
print  a$ 
put  #1 
r=r+l 

pai$=right$(par$,len(par$)-b) 

wend 

lset  a$=par$ 
print  a$ 
put#l 
r=r+l 
lset  a$="l" 
put#l 
r=r+l 
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input  rt$ 

65  NEXT  I 
70  CLOSE#  1 


DENTAL  Programmer’s  Manual  B-8 


Appendix  C 
Definition  File  Listings 


DEF.TXT 

Abscess:  Localized  accumulation  of  purulent  material  or  pus,  usually  acute 
Acute:  Sharp;  having  a  short  and  relatively  severe  course 
Alveolar  Bone:  The  bone  of  the  mandible  or  maxilla  that  supports  teeth 
Anomaly:  Deviation  from  normal 

Apical:  Referring  to  the  apex  of  a  tooth;  end  of  the  tooth  opposite  the  crown 

Atrophy:  A  wasting  away  or  diminution  in  the  size  of  the  tissue/organ 

Avulsed:  Separated  or  detached  forcibly 

Blunted:  Flattened  with  loss  of  scalloped  (pointed)  shape 

Buccal:  Pertaining  to  the  cheeks  or  the  cheek  side 

Bulla:  A  large  blister  or  cutaneous  vesicle  filled  with  serous  fluid 

Cellulitis:  Diffuse,  usually  subcutaneous  spreading  inflammation  of  connective  tissue 

Chronic:  Long-standing;  not  acute 

Cleft:  A  longitudinal  opening  or  fissure 

Crepitus:  Cracking  or  grating  sound 

Cyst:  A  sac-like  structure  filled  with  a  liquid  or  semisolid  substance 

Dentin:  The  light-yellowish  tooth  substance  that  surrounds  the  pulp  and  is  covered  by  enamel 
Desquamation:  The  shedding  of  epithelial  elements/cells  in  scales  or  sheets  (surface  layers  of  tissue) 
Diffuse:  Not  definitely  limited  or  localized 
Diplopia:  Double  vision 
Discrete:  Separate  or  distinct 

Enamel:  The  white,  hard  substance  that  covers  and  protects  the  dentin  of  the  crowns  of  teeth 
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Endodontic:  Pertaining  to  the  pulp  of  the  tooth 
Enopthalmia:  Retraction  of  the  eye  into  the  orbit 
Eroded:  Worn  away;  destroyed  over  time 
Exophytic:  Outwardly  growing 
Exopthalmia:  Abnormal  protrusion  of  the  eye 
Fissured:  Having  clefts  or  grooves 

Fluctuant:  Having  a  wave-like  motion  or  the  sensation  of  being  fluid-filled 
Generalized:  Throughout;  not  localized 

Gingiva:  Gum  tissue;  keratinized  mucosal  tissue  that  surrounds  the  necks  of  the  teeth 
Glossodynia:  Pain  in  the  tongue 

Hemorrhagic:  Pertaining  to  or  characterized  by  bleeding 

Hyperplastic:  Pertaining  to  an  abnormal  multiplication  or  increase  in  the  number  of  normal  cells 
in  normal  arrangement  in  a  tissue 

Infraorbital  Rim:  Bony  rim  palpable  just  below  the  eye 

Intercanthal  Distance:  Distance  between  the  medial  comers  of  the  eye 

Irreversible  Pulpitis:  A  state  of  pulpal  inflammation  in  which  the  pulp  does  not  have  the  potential 
to  return  to  a  state  of  health 

Keratotic:  Having  a  homy/keratinized/somewhat  fibrotic  nature;  usually  whitish  in  appearance; 
cannot  be  rubbed-off 

Lobulated:  Made  up  of  or  divided  into  lobules 
Localized:  Restricted  to  a  limited  region;  not  generalized 
Lingual:  Pertaining  to  the  tongue  or  tongue  side 
Macroglossia:  Enlarged  tongue 

Malaise:  Unlocalized  body  uneasiness,  debility,  or  discomfort 
Mandibular:  Pertaining  to  the  lower  jaw  or  mandible 
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Maxillary:  Pertaining  to  the  upper  jaw  or  maxilla 

Membranous:  Pertaining  to  a  membrane;  pertaining  to  a  thin  layer  of  tissue  which  covers  a  surface 
Microglossia:  Under  size  of  the  tongue 

Mobility:  (Dental)  pertaining  to  an  increased  buccal/lingual  (sideways)  or  vertical  movement  of 
the  teeth 

Mucosa:  Mucous  membrane;  (oral)  the  tissue  lining  inside  the  mouth 

Muscles  of  Mastication:  Primarily  the  masseter,  temporalis,  medial  pterygoid  and  lateral  pterygoid 
muscles 

Myofacial:  Referring  to  muscles  of  the  face 

Necrotic/Necrotizing:  Having  characteristics  of  necrosis  or  non-vitality 
Nodules:  A  small  boss  or  node  which  is  solid  and  detectable  by  touch 

Occlusion/Occlusal  Surface:  Pertaining  to  the  bite  or  interdigitation  of  the  teeth;  the  biting  surface 

Papillary:  Pertaining  to  or  resembling  small  nipple-shaped  projections  or  elevations 

Parotid-area:  Pertaining  to  the  area  of  the  parotid  salivary  gland;  anterior  and  inferior  to  the  ear 

Periodontal/Periodontic:  Pertaining  to  the  supporting  structures  of  teeth  (i.e.  gingiva,  bone, 
periodontal  ligament,  and  cementum) 

Periodontitis:  Inflammation  of  the  supporting  structures  of  the  teeth 
Preauricular:  In  front  of  the  ear 

Probing  Depth:  Depth  of  a  periodontal  pocket/sulcus  measured  in  mm  from  the  gingival  margin  to 
the  base  of  the  pocket/sulcus 

Pulp:  The  vascular,  nervous,  and  connective  tissue  contained  within  the  pulp  chamber  in  the  center 
of  the  tooth 

Pulpitis:  Inflammation  of  the  pulp 

Purulence:  The  condition  of  having  or  containing  pus 

Racial  Pigmentation:  (Dental)  normal  pigmentation  of  the  mucosa/gingiva;  characterized  by  a 
diffuse  generalized  appearance;  more  commonly  found  in  dark-skinned  persons 
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Restoration:  A  dental  filling 

Reversible  Pulpitis:  A  state  of  pulpal  inflammation  in  which  the  pulp  has  the  potential  to  return  to 
a  state  of  health 

Sequestrum:  That  which  is  sequestered  or  given  off;  often  refers  to  a  small  fragment  of  non-vital 
bone 

Sinusitis:  Inflammation  of  a  sinus  or  sinuses 
Spontaneous:  Occurring  for  no  particular  reason  or  stimulus 
Supernumerary:  Extra;  above  the  normal  number 

Temporomandibular  Joint  (TMJ):  The  joint(s)  which  connects  the  mandible  to  the  temporal  bene 

Ulcers/Ulcerated:  A  loss  of  substance  on  a  cutaneous  or  mucous  surface  causing  gradual  disintegra¬ 
tion  and  necrosis  of  the  tissues 

Vesicular:  Pertaining  to  small  blisters  or  serous-filled  elevations 
Zygomatic  arch:  The  bony  arch  formed  by  zygomatic  bone  (malar/cheek  bone) 


DENTAL  Programmer  s  Manual  C-4 


Appendix  C 
Definition  File  Listings 


DEF.IDX 


1 

Abscess 

2 

3 

Acute 

1 

4 

2 

Alveolar  Bone 

6 

Anomaly 

1 

7 

Apical 

2 

9 

Atrophy 

2 

11 

Avulsed 

1 

12 

Blunted 

1 

13 

Buccal 

1 

14 

Bulla 

2 

16 

Cellulitis 

2 

18 

Chronic 

1 

19 

Cleft 

1 

20 

Crepitus 

1 

21 

Cyst 

2 

23 

Dentin 

2 

25 

2 

Desquamation 

27 

Diffuse 

1 

28 

Diplopia 

1 

29 

Discrete 

1 

30 

Enamel 

2 
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32  1 
Endodontic 

33  1 
Enopthalmia 

34  1 
Eroded 

35  1 
Exophytic 

36  1 
Exopthalmia 

37  1 
Fissured 

38  2 
Fluctuant 

40  1 
Generalized 

41  2 
Gingiva 

43  1 
Glossodynia 

44  1 
Hemorrhagic 

45  3 
Hyperplastic 

48  1 
Infraorbital  Rim 

49  2 

Intercanthal  Distance 
51  3 

Irreversible  Pulpitis 
54  3 

Keratotic 

57  1 
Lobulated 

58  1 
Localized 

59  1 
Lingual 

60  1 

Macroglossia 
61  2 

Malaise 

63  1 
Mandibular 

64  1 
Maxillary 

65  2 
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Membranous 

67  1 
Microglossia 

68  3 

Mobility 
71  2 

Mucosa 

73  3 

Muscles  of  Mastication 

76  1 
Myofacial 

77  2 

Necrotic 
77  2 

Necrotizing 
79  2 

Nodules 

81  2 

Occlusal  Surface 
81  2 

Occlusion 
83  2 

Papillary 
85  2 

Parotid-area 
87  3 

Periodontal 
87  3 

Periodontic 
90  2 

Periodontitis 

92  1 
Pre  auricular 

93  3 

Probing  Depth 
96  3 

Pulp 

99  1 
Pulpitis 

100  1 

Purulence 
101  4 

Racial  Pigmentation 

105  1 
Restoration 

106  3 
Reversible  Pulpitis 
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109  2 

Sequestrum 
111  1 

Sinusitis 
112  2 

Spontaneous 

114  1 
Supernumerary 

115  2 

Temporomandibular  Joint  (TMJ) 
117  3 

Ulcerated 
117  3 

Ulcers 
120  2 

Vesicular 
122  2 

Zygomatic  arch 
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Appendix  C 
Definition  File  Listings 


DISDEF.TXT 


Abscess/Infection/Cellulitis:  As  used  in  this  program, 
this  is  a  catch-all  category.  With  any  of  the  three  areas, 
many  of  the  classic  signs  of  an  infection  are  usually 
present  and  may  include  any  or  all  of  the  following: 
swelling,  redness,  pus  formation,  elevated  temperature,  and 
malaise.  An  abscess  is  a  localized  accumulation  of  pus  and 
may  vary  in  size.  An  abscess  may  develop  into  a  cellulitis 
which  is  a  diffuse,  usually  subcutaneous  spreading  of 
inflammation  which  may  become  life-threatening. 

Acute  Apical  Abscess:  An  advanced  exudative  and  profoundly 
symptomatic  inflammatory  response  of  the  periapical 
connective  tissues.  It  is  caused  by  contaminants  from  the 
pulp  canal  that  produce  a  steadily  increasing  amount  of 
inflammatory  exudate  (edema)  and  later,  pus. 

Radiographically  the  apical  area  of  the  tooth  may  appear 
normal.  Pus  often  drains  through  the  alveolar  bone  forming 
a  clinically  fluctuant  swelling,  often  on  the  mucosa 
overlying  the  apex  of  the  involved  tooth.  Some  relief  of 
pain  is  often  experienced  upon  rupture  or  drainage  of  the 
abscess. 

Acute  Apical  Periodontitis:  The  initial  exudative  and 
moderately  symptomatic  inflammatory  reaction  of  the 
periapical  connective  tissues.  It  is  usually  caused  by 
contaminants  from  the  pulp  canal  which  produce  exudation  in 
the  periapical  area,  however,  a  milder  form  of  acute  apical 
periodontitis,  unrelated  to  pulpal  disease,  can  occur  from 
occlusal  trauma.  There  is  no  swelling  but  the  tooth  is 
tender  to  percussion.  When  caused  by  pulpal  disease,  this 
condition  usually  progresses  to  an  acute  apical  abscess. 

Acute  Gingivitis:  Acute  inflammation  of  the  gingiva 
characterized  by  red,  painful,  bleeding  gingival  tissues. 

Acute  Herpetic  Gingivostomatitis:  An  acute  viral  disease 
characterized  by  multiple  vesicle  formation  and  gingival 
inflammation.  The  vesicles  may  form  on  most  areas  of  the 
mouth,  as  opposed  to  aphthous  ulcers  (canker  sores)  which 
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form  on  non-keratinized  tissue  and  are  usually  single  in 
number.  The  vesicles  are  not  usually  seen  as  they  rupture 
early  and  form  whitish  ulcers,  each  surrounded  by  a  reddish 
halo.  In  its  primary  form,  the  condition  is  often  quite 
painful  and  the  patient  may  complain  of  a  sore  mouth.  The 
patient  may  have  an  elevated  temperature,  malaise,  and 
lymph  node  involvement.  Because  of  the  sore  mouth,  fluid 
intake  needs  to  be  maintained  to  avoid  dehydration.  In  a 
recurrent  form,  small  ulcers/sores  are  often  found  on  the 
lateral  areas  of  the  palate,  near  the  bicuspids  and  molars. 

Carious  Lesion  (Decay):  A  microbial  disease  of  the 
calcified  tissues  of  the  teeth,  characterized  by 
demineralization  of  the  inorganic  portion  and  destruction 
of  the  organic  substance  of  the  tooth.  Clinically,  it 
varies  in  color  from  orange  to  brown  but  is  always  soft  and 
can  be  penetrated  by  a  sharp  instrument  such  as  a  dental 
explorer.  Untreated,  a  carious  lesion  can  progress 
to  involve  the  pulp  of  the  tooth  and  lead  to  pulpitis, 
acute  apical  periodontitis,  and  acute  apical  abscess. 
Sensitivity  to  sweets/sugar  may  suggest  a  carious  lesion. 

Defective  Restoration:  Imperfections,  fractures,  open 
margins  or  other  undesirable  attributes  in  dental 
restorations  (ex.  fillings,  crowns,  etc.)  which  are 
conducive  to  the  development  of  dental  caries.  This  in 
turn  may  lead  to  pulpal  death  and  endodontic  problems.  A 
dental  explorer  placed  in  the  restoration/tooth  interface 
may  detect  the  softer  carious  tooth  structure. 

Dentin  Hypersensitivity:  Excessive  sensitivity  of  dentin, 
which  is  the  light  yellowish  calcific  tissue  underlying  the 
cementum  or  enamel  that  forms  the  body  of  a  tooth. 
Clinically,  dentin  hypersensitivity  usually  occurs  near  the 
gingival  margin.  Dentin  is  often  exposed  near  the  gingival 
margin  from  gingival  recession  or  from  toothbrush  abrasion 
of  the  relatively  thin  enamel  layer  in  this  area.  The 
sensitivity  is  usually  to  cold,  but  may  be  to  touch  and  hot 
as  well.  The  sensitivity  does  not  linger  after  the 
stimulus  is  removed. 

Displacement/Mobility  of  Tooth,  Favorable  Prognosis:  As  a 
result  of  trauma,  the  prognosis  for  a  displaced  or  mobile 
tooth  is  favorable  when  only  relatively  minor  displacement 
or  mobility  of  the  tooth  exists,  the  tooth  was  otherwise 
healthy  prior  to  the  trauma,  and  no  other  compromising 
conditions  exist  such  as  an  alveolar  fracture. 
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Displacement/Mobility  of  Tooth,  Guarded  Prognosis:  As  a 
result  of  trauma,  the  prognosis  for  a  displaced  or  mobile 
tooth  is  guarded  when  the  tooth  is  extremely  mobile  or  was 
not  otherwise  healthy  before  the  trauma  or  an  alveolar 
fracture  is  present. 

Enamel  Fracture:  This  condition  occurs  when  the  crown  of 
the  tooth  has  been  traumatized  and  the  damage  is  confined 
strictly  to  the  enamel.  Although  the  tooth  may  be 
sensitive,  this  condition  is  of  relatively  minor 
importance. 

Endodontic/Periodontic  Combined  Problem:  In  this  situation 
both  periodontal  and  endodontic  etiologies  exists.  In 
order  for  healing  to  occur  both  root  canal  treatment  and 
periodontal  therapy  are  necessary. 

Food  Impaction:  Forceful  wedging  of  food  between  the 
teeth.  Gingival  tissues  in  an  area  of  food  impaction  are 
usually  red  and  bleed  easily,  and  may  be  painful.  A  foul 
odor  may  be  present. 

Fractured  Alveolar  Bone:  A  fracture  of  the  alveolar 
process  which  may  or  may  not  involve  the  alveolar 
socket.  Commonly  located  in  the  anterior  area,  they  can 
also  affect  other  areas.  The  fracture  line  may  be  apical 
to  the  apices  (ends)  of  the  teeth,  but  in  most  cases 
involves  the  alveolar  socket.  In  these  cases  associated 
dental  injuries  such  as  extrusive  or  lateral  luxations  and 
root  fractures  are  common  findings.  Fractures  of  the 
alveolar  process  can  usually  be  diagnosed  by  finding 
displacement  and  mobility  of  the  fragment.  Approximately 
75%  of  teeth  in  the  line  of  an  alveolar  fracture  become 
devitalized  and,  if  not  extracted  or  treated  with 
endodontics,  can  result  in  endodontically-related 
emergencies. 

Fractured  Crown,  Large  Pulp  Exposure:  A  tooth  that  is 
fractured  with  its  pulp  exposed  with  a  size  greater  than  1 
mm  in  diameter  is  considered,  for  purposes  of  this  program, 
to  be  a  fractured  crown  with  a  large  pulp  exposure.  A 
large  pulp  exposure  cannot  usually  be  treated 
predictably  to  retain  pulp  vitality  and  endodontic 
treatment  (root  canal)  is  usually  ultimately  necessary. 
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Fractured  Crown,  Pulp  Not  Exposed:  This  condition  occurs 
when  the  crown  of  a  tooth  has  been  fractured  exposing  the 
dentin  but  not  the  pulp.  Depending  on  the  extent  of  the 
fracture,  the  tooth  may  be  quite  sensitive.  Prolonged 
exposure  of  the  dentin  may  result  in  pulpal  death  depending 
in  part  on  the  proximity  of  the  fracture  line  to  the  pulp. 

Fractured  Crown,  Small  Pulp  Exposure:  A  tooth  that  is 
fractured  with  its  pulp  exposed  with  a  size  less  than  1  mm 
in  diameter  is  considered,  for  purposes  of  this  program,  to 
be  a  fractured  crown  with  a  small  pulp  exposure.  When  a 
small  pulp  exposure  is  properly  treated,  pulpal  vitality 
may  be  retained. 

Fractured  Mandible:  Mandibular  fractures  are  classified 
into  various  types,  depending  on  the  location  of  the 
fracture  and  whether  or  not  the  fracture  is  simple, 
compound,  or  comminuted.  The  incidence  of  fractures  by 
sites  is  approximately  as  follows:  angle  31%,  condyle  18%, 
molar  region  15%,  mental  region  14%,  symphysis  8%,  cuspid 
7%,  ramus  6%  and  coronoid  process  1%. 

Fractured  Maxilla/Fractured  Facial  Bones:  Maxillary/facial 
fractures  are  serious  injuries  because  they  involve 
important  anatomical  structures.  The  nasal  cavity, 
maxillary  antrum,  orbit,  and  brain  may  be  involved 
primarily  by  trauma  or  secondarily  by  infection.  Cranial 
nerves,  major  blood  vessels,  vascular  areas,  thin  bony 
walls,  multiple  muscular  attachments,  and  specialized 
epithelia  characterize  this  region  in  which  injury  can 
result  in  serious  and  life-threatening  sequelae.  There  are 
multiple  types  of  fractures  that  can  occur  in  this  area. 

Internal  Derangement  of  the  Temporomandibular  Joint:  A 
broad  category  which  includes  any  internal  malrelationship 
of  the  temporomandibular  joint,  the  articular  disk,  and 
associated  structures.  A  malposed/diseased/degenerated 
articular  disk  may  result  in  clicking,  popping,  or  locking 
of  the  joint.  Pain  is  usually  in  or  around  the  joint  and 
usually  increases  during  mastication.  This  condition  may 
be  associated  with  myofascial  pain/muscle  spasms. 

Irreversible  Pulpitis:  A  condition  of  the  pulp  in  which 
there  are  painful  episodes  which  are  spontaneous  and 
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continuous  and  often  aggravated  by  heat  or  cold.  The 
patient  may  have  had  a  previous  history  of  pain  in  the  same 
tooth. 

Localized  Alveolar  Osteitis  (Dry  Socket):  A  breakdown  or 
improper  formation  of  the  blot  clot  that  normally  forms  in 
an  extraction  site  and  which  is  necessary  for  healing.  It 
most  commonly  develops  on  the  third  or  fourth  day  after 
extraction  and  in  conjunction  with  the  extraction  of  a 
lower  wisdom  tooth.  It  is  characterized  by  continuous  pain 
in  the  general  extraction  site  area  which  may  radiate  to 
the  ear.  A  necrotic  odor  is  frequently  present 
Irrigation  with  sterile  saline  and  eugenol/iodoform  gauze 
dressings  are  used  to  treat  the  condition. 

Maxillary  Sinusitis:  Inflammation  of  the  maxillary  sinus, 
the  bony  cavity  in  the  body  of  the  maxilla,  superior  to  the 
alveolar  process,  lateral  to  the  nasal  cavity,  and 
communicating  with  the  middle  meatus  of  the  nose.  Symptoms 
include  percussion  sensitivity  of  the  maxillary  bicuspid 
and  molar  teeth,  often  generalized  rather  than  to  a 
specific  tooth.  The  pain  usually  increases  when  the 
position  of  the  head  is  rapidly  changed,  such  as  lowering 
it.  The  patient  usually  reports  having  a  recent  cold  or 
sinus  problem. 

Myofascial  Pain/Muscle  Spasms:  Discomfort  or  pain 
associated  with  the  muscles  of  mastication  and  related  to 
the  temporomandibular  joint.  For  treatment  purposes, 
muscles  may  be  viewed  as  being  in  a  spastic  state.  This 
condition  is  often  related  to  stress,  habits,  or  occlusal 
malreladonships  and  patients  need  to  be  carefully 
questioned  and  examined.  Parafunctional  habits  may  include 
grinding  or  clenching  of  the  teeth  or  gum  chewing;  pain 
related  to  night  grinding  is  often  more  intense  in  the 
morning  after  waking  up.  Treatment  is  directed  at 
reducing  stress,  physical  therapy,  and  correcting  habits. 

The  occlusion  can  be  addressed  by  a  dentist  Bite  splints 
are  prosthetic  devices  often  used  by  dentists  to,  among 
other  things,  deprogram  the  muscles  and  help  them  "relax." 

This  condition  may  be  associated  with  an  internal 
derangement  of  the  joint(s). 

Necrotizing  Ulcerative  Gingivitis:  An  acute  gingival 
infection  characterized  by  an  extremely  foul  oral  odor; 
bleeding,  painful  gingiva;  development  of  a  white,  easily 
removable  pseudomembrane  over  the  gingival  tissues;  and 
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blunting  of  the  interdental  papillae  (the  tissue  between 
the  teeth).  Malaise,  elevated  temperature,  and  lymph  node 
involvement  may  be  present.  This  condition  is  also  called 
trenchmouth,  Vincent’s  infection,  and  NUG  and  ANUG. 

Neurologic  Injury:  Within  the  context  of  this  program, 
after  trauma  to  the  head,  the  following  usually  indicate  a 
neurologic  injury:  1)  loss  of  consciousness,  2)  vomiting, 
or  3)  amnesia. 

Occlusal  Trauma:  An  abnormal  occlusal  force  on  a  tooth, 
often  resulting  from  a  malocclusion  or  an  improper  (ex. 

"high")  restoration.  The  involved  tooth/teeth  often  feel 
sore  and  have  an  increased  mobility.  When  the  supporting 
structures  of  the  teeth  have  been  lost,  for  example  bone 
and  attachment  loss  from  periodontal  disease,  then  even 
normal  occlusal  forces  acting  on  a  compromised  periodontium 
may  act  with  traumatic  results. 

Osseous  Sequestrum:  During  extraction  of  a  tooth,  small 
fragments  of  bone  may  be  fractured  from  the  socket.  These 
pieces  of  bone  may  become  non-vital  and  work  their  way  to 
the  surface  of  the  tissue  one  to  two  months  after  the 
extraction  until  they  are  sequestered. 

Pericoronitis/Erupting  Tooth:  Pericoronitis  is 
classically  an  acute,  painful  inflammation  of  the  tissues 
overlying  a  partially  erupted  lower  third  molar  (wisdom 
tooth).  The  third  molar  may  only  appear  on  radiographs. 
Typical  symptoms  may  include  lymphadenopathy,  trismus,  pain 
in  the  region  of  the  third  molar,  malaise,  and  elevated 
temperature.  These  symptoms  may  vary  from  mild  to  severe 
pain.  The  patient  may  develop  a  cellulitis  capable  of 
producing  difficulty  in  swallowing,  and  the  patient  can 
have  extreme  tenderness  to  palpation  extraorally  and 
intraorally  and  edema  visible  in  the  submandibular  and 
pharyngeal  regions.  Untreated,  respiratory  compromise 
and/or  progression  of  the  infection  to  the  mediastinum  may 
result. 

Periodontal  Abscess:  A  localized  area  of  pus  formation 
originating  from  inflammation  in  the  periodontal  pocket  or 
space  and  manifesting  as  a  swelling  on  the  gingival  (gum) 
tissues.  Periodontal  abscesses  rarely  progress  to  a 
cellulitis  and,  although  they  may  be  uncomfortable,  are 
somewhat  self-limiting. 
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Reversible  Pulpitis:  A  condition  of  the  pulp  in  which 
there  are  painful  episodes  of  short  duration  initiated  by 
an  external  stimulus  (ex.  touch,  cold,  heat).  A  history  of 
recent  dental  procedures  (ex.  new  filling,  root  planing),  a 
faulty  restoration,  or  cervical  erosion  may  help  establish 
this  as  a  possible  diagnosis. 

Root  Fracture:  Total  or  partial  separation  of  an  otherwise 
intact  root.  Fractures  can  be  obvious  or  hairline  and  can 
be  in  horizontal  or  vertical  directions.  Although  it 
depends  on  the  direction,  location  on  the  root,  and  the 
extent  of  the  fracture,  the  prognosis  for  teeth  with  root 
fractures  is  usually  extremely  guarded.  Extraction  of  the 
teeth  is  often  the  ultimate  sequelae. 

Total  Avulsion  of  Tooth,  Good  Candidate  for  Replantation: 
A  tooth  that  is  a  good  candidate  for  replantation  is  one 
that  1)  was  otherwise  healthy  before  being  avulsed;  2)  has 
been  avulsed  for  less  than  3  hours;  3)  is  generally  intact; 
and  4)  has  an  intact  socket  into  which  to  reimplant  the 
tooth.  It  is  best  if  the  tooth  is  not  allowed  to  dehydrate 
before  reimplanting. 

Total  Avulsion  of  Tooth,  Poor  Candidate  for  Replantation: 
A  tooth  that  is  a  poor  candidate  for  replantation  is  one  in 
which  any  of  the  following  conditions  have  been  met:  1) 
the  tooth  has  been  avulsed  for  longer  than  3  hours;  2)  the 
tooth  is  not  intact;  or  3)  the  socket  to  which  the  tooth 
should  be  reimplanted  is  not  intact.  In  some  cases,  if  the 
tooth  was  not  healthy  before  being  avulsed  or  was  allowed 
to  dehydrate,  it  is  not  usually  a  good  candidate  for 
replantation. 
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Appendix  C 
Definition  File  Listings 

DISDEF.IDX 


1  9 

Abscess/Infeetion/Cellulitis 
10  11 

Acute  Apical  Abscess 
21  9 

Acute  Apical  Periodontitis 
30  2 

Acute  Gingivitis 
32  14 

Acute  Herpetic  Gingivostomatitis 

46  10 

Carious  Lesion  (Decay) 

56  7 

Defective  Restoration 
63  10 

Dentin  Hypersensitivity 
73  6 

Displacement/Mobility  of  Tooth,  Favorable  Prognosis 
79  5 

Displacement/Mobility  of  Tooth,  Guarded  Prognosis 
84  5 

Enamel  Fracture 
89  4 

Endodontic/Periodontic  Combined  Problem 
93  4 

Food  Impaction 
97  14 

Fractured  Alveolar  Bone 
111  7 

Fractured  Crown,  Large  Pulp  Exposure 
118  6 

Fractured  Crown,  Pulp  Not  Exposed 
124  6 

Fractured  Crown,  Small  Pulp  Exposure 
130  7 

Fractured  Mandible 
137  10 

Fractured  Maxilla/Fractured  Facial  Bones 
147  8 

Internal  Derangement  of  the  Temporomandibular  Joint 
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155  5 

Irreversible  Pulpitis 
160  10 

Localized  Alveolar  Osteitis  (Dry  Socket) 

170  10 

Maxillary  Sinusitis 
180  16 

Myofascial  Pain/Muscle  Spasms 
196  8 

Necrotizing  Ulcerative  Gingivitis 
204  4 

Neurologic  Injury 
208  8 

Occlusal  Trauma 
216  5 

Osseous  Sequestrum 
221  14 

Pericoronitis/Erupting  Tooth 
235  6 

Periodontal  Abscess 
241  6 

Reversible  Pulpitis 
247  7 

Root  Fracture 
254  7 

Total  Avulsion  of  Tooth,  Good  Candidate  for  Replantation 
261  9 

Total  Avulsion  of  Tooth,  Poor  Candidate  for  Replantation 
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Appendix  D 

Treatment  Plan  File  Listing 


TRTMTS.TXT 


Please  carefully  review  your  information  and  repeat  the  program.  If  a 
diagnosis  cannot  be  made  after  repeated  attempts  try  using  a  related 
area  on  the  menus  (ex.  try  No.  1  "Tooth,  Specific"  on  the  Not  Trauma-related 
Menu  if  a  specific  diagnosis  was  not  obtained  by  using  No.  2  "Teeth  Generalized  or 
Multiple  Adjacent"  Remember,  the  diagnostic  outcomes  produced  by  this  program 
can  be  highly  influenced  by  the  answer  of  only  one  question.  Read  and  answer 
each  question  carefully. 


As  a  last  resort  try  using  the  Soft  Tissue  Lesions  Section  of  the  program 
(No.  3  on  the  Main  Menu)  for  a  differential  diagnosis. 

Localized  Alveolar  Osteitis  --  Irrigate  the  socket  with  sterile  saline.  The 
extraction  site  should  then  be  packed  with  a  single  2  inch  piece  of  1/8  inch 
iodoform  gauze  to  which  a  drop  of  eugenol  has  been  added.  Gendy  insert  the 
gauze  to  the  full  depth  of  the  site.  Pack  loosely.  A  dramatic  decrease  in 
symptoms  should  occur  within  10  minutes.  Replace  eugenol/gauze  pack  every 
clay  for  about  a  week.  Remove  the  pack  permanently  after  2  weeks.  Hot 
saline  rinses  and  analgesics  may  provide  additional  relief  during  the  2  week 
treatment  period. 

Osseous  Sequestrum  —  Treatment  is  generally  palliative  until  such  time  as  the 
sequestrum  can  be  removed  atraumatically  with  instruments  or  is  exfoliated  on 
its  own.  Hot  saline  rinses  with  analgesics  and  avoidance  of  the  area  by  the 
patient  when  eating  will  help.  If  the  sequestrum  is  not  exposed,  a  few  drops  of 
local  anesthetic  can  be  deposited  in  the  area  and  an  attempt  can  be  made  to 
crush  the  spicule  through  the  tissue  using  a  blunt  instrument.  Observe  the 
area  closely  and  monitor  for  possible  infection.  A  usually  short-lived  soft 
tissue  defect  may  develop.  Antibiotics  are  not  usually  indicated. 

Abscess/Infection/Cellulitis  -  Maintain  vital  signs/airway.  Correct  the  cause 
if  possible.  Establish  drainage  if  purulence  is  suggested  and  if  feasible, 
considering  anatomic  structures  and  individual  abilities.  Perform  culture 
and  sensitivity  tests  if  possible.  Administer  antibiotics  (penicillin  is  the  drug  of 
choice  if  not  otherwise  contraindicated).  Use  sedatives/analgesics  cautiously  as  they 
can  compromise  respirations.  Maintain  hydration  and  nutrition.  If  a  dental  etiology 
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is  suspected  review  recommendations  for  periodontal  and  periapical  abscesses. 

If  the  patient  does  not  respond  MEDEVAC  in  prone/lateral  prone  position  to  help 
maintain  the  airway.  These  patients  can  become  very  sick;  do  not  hesitate  to 
MEDEVAC. 

Periodontal  Abscess  —  Treatment  consists  primarily  of  establishing  drainage 
through  the  gingival  sulcus,  if  possible,  using  a  periodontal  curette  or  probe. 

If  this  is  not  possible,  conservative  I  &  D  can  be  attempted  by  applying  topical 
anesthetic  and  making  a  small  (2-3  mm)  shallow  incision  at  the  height  of  the 
fluctuant  swelling.  After  the  incision  is  made,  explore  the  abscess  area  for 
purulence  using  a  blunt  instrument.  Avoid  surgical  I  &  D  on  the  lingual  surfaces  of 
the  lower  teeth  as  there  are  many  important  anatomical  considerations. 

Hot  saline  rinses  and  analgesics  will  help.  Antibiotics  are  not  usually  indicated. 
Refer  the  patient  for  a  periodontal  consult  at  the  earliest  convenience. 

Reversible  Pulpitis  -  Treatment  consists  of  removal  of  the  pain  stimulus  and/or 
protection  of  the  tooth  from  the  stimulus.  In  this  case  the  stimulus  may  be 
transient  thermal  sensitivity.  Sometimes  only  counseling  is  needed.  Local 
anesthesia/analgesics  may  be  necessary.  If  caries  are  present,  anesthetize  the 
area  and  isolate  the  tooth  with  2x2  gauze  and  remove  the  caries  until  either 
discomfort  is  felt  or  hard  tooth  structure  is  encountered.  Mix  and  place  a 
zinc  oxide  and  eugenol  restoration.  If  a  restoration  cannot  be  placed,  monitor 
the  tooth  for  development  of  irreversible  pulpitis.  Antibiotics  are 
not  necessary.  Refer  the  patient  for  definitive  dental  treatment  at  the 
earliest  convenience. 

Irreversible  Pulpitis  --  If  the  tooth  has  caries,  anesthetize  and  isolate 
the  tooth  with  2x2  gauze.  Remove  the  caries  until  the  pulp  is  exposed  1  mm 
or  more  then  place  a  cotton  pellet  which  has  been  lightly  moistened  with 
formocresol  to  the  deepest  part  of  the  cavity.  Mix  a  zinc  oxide  and  eugenol 
restoration  and  place  it  to  cover  the  cotton  pellet.  Use  analgesics.  After  3- 
6  hours  continue  to  monitor  closely  if  the  situation  improves.  If  not  repeat 
above  procedures  and  try  to  remove  more  caries  or  pulp  tissue.  If  unable  use 
analgesics  and  arrange  for  definitive  care  ASAP.  Antibiotics  are  usually  not 
needed.  MEDEVAC  of  the  patient  may  be  necessary.  Refer  the  patient  for 
endodontic  evaluation  ASAP. 

Acute  Apical  Abscess  -  If  caries  are  present  anesthetize  and  isolate  the  tooth 
with  2x2  gauze.  Remove  caries  and  pulp  contents  with  spoon  excavators  to 
establish  drainage  through  the  crown  of  the  tooth.  Administer  antibiotics 
(penicillin  is  the  drug  of  choice  if  not  otherwise  contraindicated).  If  a 
fluctuant  swelling  is  present  apply  topical  anesthetic  and  I  &  D  with  a  No.  12 
blade  by  using  a  small  (2-3  mm)  shallow  incision.  Use  hot  saline  rinses  and 
analgesics.  If  you  are  unable  to  remove  the  caries/restoration  and,  therefore, 
unable  to  establish  drainage  through  the  tooth  then  only  I  &  D  the  abscess. 

Refer  the  patient  for  definitive  endodontic  evaluation  ASAP.  MEDEVAC  of  the 
patient  may  be  necessary  if  the  situation  does  not  respond. 
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Acute  Apical  Periodontitis  —  If  you  are  able,  vitality  tests  should  be  performed. 

If  the  tooth  is  vital  then  check  the  occlusion  and  relieve  if  able.  If  the 
tooth  is  non-vital  and  has  caries,  anesthetize  and  isolate  the  tooth 
with  2x2  gauze.  Remove  the  caries  with  spoon  excavators  and  expose  the  pulp. 
Place  a  cotton  pellet  lightly  moistened  with  formocresol  to  the  deepest  part  of 
the  cavity.  Mix  a  zinc  oxide  and  eugenol  restoration  and  place  it  over  the 
cotton  pellet  If  the  tooth  is  non-vital  and  the  caries  cannot  be  removed  then 
use  antibiotics  and  analgesics  and  monitor  closely.  This  situation  can  progress 
to  an  acute  apical  abscess.  Refer  for  endodontic  evaluation  ASAP.  MEDEVACof 
the  patient  may  be  necessary. 

Carious  Lesion  (Decay)  —  If  the  tooth  is  vital  anesthetize  and  isolate  the  tooth 
with  2x2  gauze.  Remove  the  caries  with  a  spoon  excavator  until  hard  tooth 
structure  is  encountered.  If  a  small  pulp  exposure  ( mm)  is  present,  place  a 
calcium  hydroxide  base.  If  a  large  exposure  is  present,  remove  as  much  pulp  as 
possible  and  place  a  cotton  pellet  lightly  moistened  with  formocresol  over  the 
pulp  exposure.  Mix  and  place  a  zinc  oxide  and  eugenol  restoration  over  the 
cotton  pellet  or  hard  tooth  structure  if  no  exposure  was  present.  If  the  tooth 
is  non-vital  then  follow  recommendations  for  irreversible  pulpitis.  If 
you  are  unable  to  remove  the  caries  then  use  analgesics.  Symptomatic  carious 
lesions  usually  imply  that,  at  the  very  least,  a  pulpitis  is  present.  This 
condition  may  progress  to  apical  periodontitis  or  an  apical  abscess.  Monitor 
closely  and  refer  for  definitive  care  ASAP. 

Dentin  Hypersensitivity  --  Treatment  consists  of  removal  of  the  pain  stimulus  and 
treating  the  dentin  to  make  it  less  responsive  to  the  stimulus.  Counsel  the 
patient  to  avoid  hot  and  cold  foods  or  liquids  in  the  area.  The  patient  should 
temporarily  avoid  highly  acidic  foods  such  as  oranges  or  pineapples  as  these 
may  aggravate  the  condition.  Recommend  a  desensitizing  toothpaste  to  the  patient 
and  follow  the  manufacturer’s  instructions.  If  this  is  not  available  have 
the  patient  use  a  bland  toothpaste  and  avoid  super-whitening  brands.  Refer  for 
definitive  dental  treatment  when  possible.  Mild  analgesics  such  as  aspirin  or 
acetaminophen  may  help. 

Maxillary  Sinusitis  —  To  corroborate  the  diagnosis  take  sinus  series  radiographs 
if  you  are  able  and  palpate  and  percuss  the  sinus  areas  for  sensitivity.  The 
patient  may  complain  of  frontal  headache  pain  or  a  sensation  of  supererupted 
dentition.  Question  the  patient  further  about  previous  colds  or  sinus  problems. 

A  seropurluent  or  mucopurulent  exudate  may  be  present.  Place  the  patient  on 
decongestants.  Place  the  patient  on  antibiotics  if  an  exudate  or  fever  or 
lymphadenopathy  are  evident  (ampicillin  is  the  drug  of  choice  if  not  otherwise 
contraindicated).  Monitor  the  patient  closely.  If  radiographs  reveal  other 
pathological  conditions,  follow-up  is  required.  MEDEVAC  may  be  necessary  if 
the  condition  is  unresponsive. 
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Endodontic/Periodontic  Combined  Problem  —  This  exists  when  there  are  both 

endodontic  and  periodontal  etiologies  for  the  abscess.  Review  the  treatment 

recommendations  for  both  the  periodontal  abscess  and  the  acute  apical  (endodontic) 

abscess.  The  endodontic  component  of  the  problem  is  the  more  likely 

source  of  the  discomfort  and  should  usually  be  treated  first.  Treat 

the  problem  as  if  it  were  an  acute  apical  abscess  with  the  exception  of  additionally 

trying  to  curette  the  periodontal  pockets  to  remove  any  calculus  or 

debris.  Use  antibiotics  (penicillin  is  the  drug  of  choice  if  not  otherwise 

contraindicated)  and  analgesics.  Monitor  closely.  MEDE VAC  of  the  patient  may 

be  necessary.  Refer  for  endodontic  and  periodontic  evaluation  ASAP. 

Defective  Restoration  —  If  caries  are  present,  review  treatment  recommendations 
for  carious  lesions.  If  the  restoration  has  become  displaced  or  fractured  or  a 
part  has  been  lost  then  protect  the  dentin  if  it  is  exposed  to  make  it  less  responsive  to 
painful  stimuli.  Isolate  the  tooth  with  2x2  gauze.  If  a  pulp  exposure  exists,  review 
the  treatments  recommendations  for  small  ( 1  mm)  or  large  ( 1  mm)  pulp  exposures. 

If  no  pulp  exposure  is  present  then  mix  and  place  a  zinc  oxide  and  eugenol  restoration. 
If  this  is  not  possible  then  use  analgesics  and  observe  closely.  Local  anesthesia 
is  not  usually  required.  Refer  the  patient  for  definitive  dental  care 
ASAP.  MEDEVAC  of  the  patient  may  be  necessary. 

Acute  Herpetic  Gingivostomatitis  —  Treatment  is  generally  palliative.  As  a 
primary  condition  vesicles  and  gray/white  ulcers  surrounded  by  a  red  halo  can 
be  found  throughout  the  mouth.  Adjacent  gingival  tissues  are  usually  inflamed. 

Oral  hygiene  instructions  should  be  given.  Insure  an  adequate  fluid  intake  by 
the  patient.  Analgesics  are  recommended.  In  severe  cases  rinses  of  viscous 
lidocaine  or  diphenhydramine  elixir  can  be  used.  Antibiotics  arc  only  necessary 
if  a  secondary  bacterial  infection  is  suspected.  The  condition  should 
resolve  within  2  weeks.  A  more  innocuous  recurrent  form  of  this  condition  may 
occur  and  it  is  commonly  seen  on  lateral  areas  of  the  palate.  The  classic 
ulcers  are  not  usually  seen  in  the  recurrent  form.  Rather  you  might  see  small 
vesicles  or  eroded  areas.  This  condition  is  treated  similarly  to  the  primary 
condition  although  it  is  far  less  severe.  If  only  one  or  two  painful  classic 
ulcers  are  noted  on  the  oral  mucosa  then  a  diagnosis  of  apthous  ulcer(s)  should 
be  considered.  There  generally  will  not  be  any  systemic  involvement  (i.e. 
fever  or  lymph  nodes,  etc.).  Aphthous  uclers  resolve  spontaneously  in  1-2  weeks. 

Pericoronitis/Erupting  Tooth  —  Have  the  patient  rinse  with  hot  saline  4-6  times 
a  day  for  a  week  or  so.  If  an  inflamed  flap  of  tissue  is  present  (pericoronitis) 
then  debride  the  area  under  flap  with  a  periodontal  curette  and  follow 
with  daily  irrigation  using  sterile  saline  and  a  blunt  irrigation  needle. 

Pericoronitis  can  be  a  serious  problem  and  antibiotics  should  be  considered 
early  in  treatment.  If  the  patient  has  fever/chills/lymphadenopathy/malaise, 
definitely  give  antibiotics,  usually  penicillin  IV  (8  million  units  per  day)  if  not 
otherwise  contraindicated.  If  the  patient  does  not  stabilize  within  12-24 
hours  then  MEDEVAC.  Use  analgesics  as  needed.  Monitor  and  observe  closely. 
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For  an  erupting  tooth  the  situation  is  usually  self-limiting  if  an  infection  or 
severly  inflamed  tissue  is  not  present.  Treat  this  condition  with  analgesics. 

Refer  the  patient  for  an  oral  surgery  evaluation  ASAP. 

***** 

Necrotizing  Ulcerative  Gingivitis  —  Give  the  patient  thorough  oral  hygiene 
instructions  and  have  the  patient  demonstrate  plaque  removal  to  you  daily  if 
necessary.  This  is  mandatory!  The  patient  will  bleed  when  brushing.  Debride 
the  patient’s  mouth  initially  using  curettes  or  a  toothbrush  or  wet  cotton 
balls  or  combination  of  these.  Start  the  patient  on  3%  hydrogen  peroxide 
rinses  4-6  times  a  day  for  a  week.  If  the  patient  has  fever/lymphadenopathy/malaise 
then  give  penicillin  V-K  500  mg  q6h  for  7-10  days  if  not  otherwise 
contraindicated.  Analgesics  are  helpful.  The  patient  should  promptly  improve  but 
needs  close  follow-up.  The  bleeding  of  the  gingival  tissues  may  continue  until 
more  definitive  care  can  be  provided.  Refer  the  patient  for  a  periodontal 
evaluation  ASAP.  MEDEVAC  of  the  patient  may  be  necessary. 

Acute  Gingivitis  —  Give  the  patient  thorough  oral  hygiene  instructions  and  have 
the  patient  demonstrate  brushing  and  flossing  to  you  daily  if  necessary.  Hot 
saline  rinses  and  analgesics  will  also  help.  Under  conditions  of  strict  plaque 
removal,  the  acute  stage  should  resolve  within  1-2  weeks.  If  not,  check  the  Soft 
Tissue  Lesions  Section  of  this  program  for  other  possibilities  such  as  a  blood 
dyscrasia  or  acute  herpetic  gingivostomatitis  or  allergy  or  some 
other  systemic  condition.  Antibiotics  are  not  usually  indicated.  Refer  the 
patient  for  a  periodontal  evaluation  ASAP.  MEDEVAC  is  not  usually  necessary. 

Food  Impaction  —  Using  a  periodontal  curette  or  probe  or  explorer,  attempt  to 
remove  the  impacted  food  debris.  It  is  usually  caught  between  the  teeth  and 
can  be  difficult  to  notice  because  of  the  facial  and  lingual  gingival  papillae. 

Once  the  debris  is  removed  give  the  patient  oral  hygiene  instructions  with 
emphasis  on  flossing.  Have  the  patient  rinse  with  hot  saline  4-6  times  a  day 
for  a  week  or  so.  If  all  food  debris  is  not  removed  there  is  the  potential  to 
develop  a  periodontal  abscess  or  localized  infection.  Have  the 
patient  avoid  chewing  fibrous  foods/meats  until  the  acute  condition  is 
resolved.  Refer  the  patient  for  definitive  dental  care  ASAP.  MEDEVAC  is  not 
usually  necessary. 

Myofascial  Pain/Muscle  Spasms  —  Immediate  care  consists  of:  1)  analgesics 
asprin/acetaminophen/ibuprofen);  2)  soft  diet  or  liquid  diet  (if  the  patient  has 
difficulty  opening);  3)  hot  moist  packs  4-6  times  a  day  applied  to  the  muscles 
of  mastication  (primarily  masseter/temporomandibular  joint/temporal  areas);  and  4) 
muscle  relaxants  (ex.  diazepam  PO).  If  the  patient  has  severe  trismus  consider 
IM  diazepam  5-15  mg.  Eliminate  or  reduce  any  aggravating  habits  such  as  gum 
chewing/clenching/bruxism.  Counsel  the  patient  to  reduce  stress  and  anxiety 
which  are  often  associated  with  the  problem.  Refer  the  patient  for  definitive 
dental  evaluation  when  practical.  MEDEVAC  is  not  usually  necessary. 
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Internal  Derangement  of  the  TMJ  —  If  you  are  able  take  a  screening  radiograph  to 
rule  out  obvious  pathosis.  Immediate  treatment  consists  of:  1)  analgesics 
(aspirin/acetaminophen/ibuprofen);  2)  soft  diet  (if  the  patient  feels  pressure  in  his 
joint  when  eating  the  diet  is  probably  not  soft  enough);  3)  hot  moist  packs  to 
the  joint  area  4-6  times  a  day;  4)  have  the  patient  limit  the  range  of  motion  of 
their  mandible  (do  not  have  the  patient  open  more  than  absolutely  necessary 
when  speaking/eating/yawning);  5)  eliminate  or  reduce  any  aggravating  habits 
such  as  chewing  gum/clenching/bruxism;  6)  counsel  patient  to  decrease  stress;  and 
7)  use  muscle  relaxants  (ex.  diazepam  PO).  Refer  the  patient  for  dental  evaluation 
when  practical.  MEDEVAC  is  usually  not  necessary. 

Occlusal  Trauma  —  This  can  occur  from  excessive  force  placed  on  teeth  and  is 
usually  from  a  "high"  restoration  or  bruxism  or  occlusal  discrepancies.  If  the 
teeth  hurt  primarily  in  the  morning  then  suspect  nocturnal  bruxism  and  review 
the  treatment  recomendations  for  myofacial  pain.  Determine  if  there 
are  factitious  or  parafunctional  habits  that  contribute  to  the  problem. 

Treatment  consists  of:  1)  eliminating  or  reducing  aggravating  habits  (counsel 
the  patient  to  reduce  stress  which  often  predisposes  to  bruxism);  2)  adjusting 
the  occlusion  if  able  (ex.  a  restoration  that  is  too  "high");  and  3)  having  the 
patient  avoid  masticating  in  the  affected  area  if  possible.  Refer  the  patient 
for  definitive  dental  care  when  practical.  MEDEVAC  is  not  usually  necessary. 

Fractured  Crown,  Small  Pulp  Exposure  —  Use  local  anesthesia/analgesics.  Remove 
any  mobile  tooth  fragments  if  present  and  if  you  are  able.  Isolate  the  tooth  with 
2x2  gauze  and  place  a  calcium  hydroxide  base  over  the  pulp  and  adjacent 
dentin.  If  you  are  able  apply  a  resin  temporary  restoration.  If  unable,  mix  and  place 
a  zinc  oxide  and  eugenol  restoration  to  cover  the  calcium  hydroxide  base.  If  the 
restoration  cannot  be  placed  nor  retained  observe  the  area  closely.  The  patient 
may  develop  irreversible  pulpitis.  Smooth  any  sharp  edges  on  the  tooth  with  wet/dry  220 
aluminum  oxide  sandpaper  or  a  small  round-end  metal  file.  Refer  the  patient  for 
endodontic  evaluation  and  definitive  care  when  able.  MEDEVAC  may  be  necessary. 

Fractured  Crown,  Large  Pulp  Exposure  —  Use  local  anesthesia/analgesics.  Remove 
any  mobile  tooth  fragments  if  present  and  if  you  are  able.  Remove  approximately 
2  mm  (depth)  of  pulp  tissue  with  a  spoon  excavator.  Good  anesthesia  is  desirable. 
Lightly  moisten  a  cotton  pellet  with  eugenol  or  formocresol  and  gently 
place  over  the  remaining  pulp  stump.  Mix  and  place  a  zinc  oxide  and  eugenol 
restoration.  Check  the  occlusion.  Remove  any  sharp  edges  on  the  tooth  with 
wet/dry  220  aluminum  oxide  sandpaper  or  a  small  round-end  metal  file.  Observe 
the  patient  closely  as  an  apical  abscess  or  acute  apical  periodontitis  may 
develop.  Refer  the  patient  for  an  endodontic  evaluation  and 
definitive  care  as  soon  as  practical.  MEDEVAC  may  be  necessary. 
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Total  Avulsion  of  Tooth,  Good  Candidate  for  Replantation  —  Ideally  the  tooth 
should  be  reimplanted  immediately  after  avulsion.  Use  sterile  saline  to  rinse 
any  debris  from  the  tooth  then  insert  the  tooth  to  its  original  position.  If 
there  is  a  time  delay  while  awaiting  replantation  then  store  the  tooth  in 
saline  or  milk.  Gently  rinse  the  debris  from  the  tooth  with  sterile  saline. 

Preserve  as  much  of  the  tissue  on  the  tooth  as  possible.  Remove  any  blood 
clots/foreign  bodies/bone  fragments  from  the  socket.  Local  anesthesia  is  usually 
required  if  a  time  delay  has  occurred.  Reposition  the  tooth  in  the  socket 
with  adequate  pressure  to  reseat  completely.  Stabilize  the  tooth  for  1-2  weeks 
using  sutures/floss/lighi  wire/fishline/or  dental  compound.  Give  the  patient  a 
tetanous  booster  and  antibiotics  (penicillin  if  not  otherwise  contraindicated) 
and  refer  for  for  an  endodontic  evaluation  and  definitive  care  when  able. 

MEDEVAC  may  be  necessary. 

Total  Avulsion  of  Tooth,  Poor  Candidate  for  Replantation  —  Inspect  the  tooth  to 
determine  if  tooth  fragments  remain  in  the  tooth  socket.  If  so  then  anesthetize 
and  attempt  retrieval  of  the  fragments.  If  you  are  unable  to  retrieve  fragments, 
give  antibiotics.  Remove  obvious  small  bone  chips  except  any  relatively  large  areas 
of  cortical  plate  which  remain  intimately  covered  with  soft  tissue.  Leave  these  intact 
and  attempt  to  reposition  them  if  necessary.  Suture  any  lacerations  and  have  the 
patient  close  on  a  few  2x2  gauze  squares  for  30  minutes.  Use  analgesics. 

Check  adjacent  teeth  for  trauma  or  fractures.  Antibiotics  are  not  usually 
necessary.  Refer  the  patient  for  definitive  dental  care  as  soon  as  practical.  If 
the  tooth  was  avulsed  cleanly  then  MEDEVAC  will  probably  not  be  necessary. 

Displacement/Mobility  of  Tooth,  Favorable  Prognosis  —  Local  anesthesia  and 

analgesics  may  be  needed.  Debride  and  suture  any  lacerations.  Gently 

reposition  the  tooth  to  its  original  position  using  the  patient’s  occlusion,  adjacent  teeth, 

and  input  from  the  patient  to  guide  you.  Stabilize  the  tooth  in  its  original 

position  for  1-2  weeks  with  sutures/light  wire/floss/or  fishline.  Check  to 

insure  that  the  patient  does  not  occlude  heavily  on  the  traumatized  tooth.  If 

so  either  reposition  the  tooth  or  adjust  the  occlusion  if  you  are  able.  The 

patient  will  need  dental  evaluation  and  follow-up.  Observe  closely  and  refer 

when  practical.  Monitor  for  infection.  MEDEVAC  may  be  necessary. 

Displacement/Mobility  of  Tooth,  Guarded  Prognosis  —  Local  anesthesia  and 
analgesics  are  usually  indicated.  If  the  tooth  has  a  loose  fragment  related  to  a 
fracture  line  then  attempt  to  remove  the  fragment.  If  the  remaining  tooth 
structure  is  extremely  mobile  attempt  removal  of  the  tooth. 

If  not  then  cover  the  patient  with  antibiotics  (penicillin  if  not  otherwise 
contraindicated)  and  check  regularly.  Debride  and  suture  any  lacerations. 

MEDEVAC  may  be  necessary  if  an  acute  phase  develops  which  cannot  be  resolved. 

Otherwise,  refer  for  dental  evaluation  and  treatment  at  the  earliest 

opportunity. 
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Fractured  Crown,  Pulp  Not  Exposed  --  Local  anesthesia  and  analgesics  may  be 
necessary.  Remove  any  mobile  tooth  fragments  if  you  are  able.  Isolate  the  tooth 
with  2x2  gauze  and  mix  and  place  a  calcium  hydroxide  base  to  cover  the 
exposed  dentin.  If  you  are  able,  apply  a  resin  temporary  restoration  as  per  your 
IDT  Syllabus.  If  you  are  unable  then  paint  two  layers  of  cavity  varnish  over 
the  calcium  hydroxide  base  (or  dentin  alone  if  a  base  cannot  be  placed).  The 
base  may  be  difficult  to  retain  and  may  need  frequent  replacement.  Smooth  any 
sharp  edges  with  220  wet/dry  aluminum  oxide  sandpaper  or  a  small  round-end 
metal  file.  Monitor  the  patient  closely  for  development  of  a  pulpitis.  Refer 
the  patient  for  definitive  care  when  able.  MEDEVAC  is  usually  not  necessary. 

Enamel  Fracture  --  Local  anesthesia  and  analgesics  are  not  usually  necessary. 

Check  the  location  of  the  fracture  or  sharp  edge  by  sight/feel/and 
conversation  with  the  patient  Remove  any  mobile  tooth  fragments  if  you  are  able. 
Smooth  any  sharp  edges  with  wet/dry  220  aluminum  oxide  sandpaper  or  a  small 
round-end  metal  file.  Smooth  the  sharp  edges  until  they  feel  smooth  to  your 
finger  and  to  the  patient’s  tongue.  Refer  the  patient  when  practical  for 
follow-up  dental  evaluation  and  treatment.  MEDEVAC  is  usually  not  necessary. 

Root  Fracture  —  Use  local  anesthesia  and  analgesics.  Isolate  the  tooth  with  2  x 
2  gauze.  If  part  of  the  tooth  is  extremely  mobile  then  attempt  its  removal.  If 
the  tooth  itself  is  extremely  mobile  consider  its  removal.  If  not,  attempt  to 
cover  any  exposed  pulp  tissue  with  a  calcium  hydroxide  base  followed  by  a  zinc 
oxide  and  eugenol  restoration.  Place  the  patient  on  antibiotics  (usually 
penicillin  if  not  otherwise  contraindicated).  If  a  base  or  restoration  cannot  be 
placed  then  observe  the  patient  closely  as  an  apical  abscess/apical  periodontitis 
may  develop.  A  periodontal  abscess  can  also  develop.  MEDEVAC  may  be  necessary. 
Refer  for  dental  evaluation  and  treatment  when  able. 

Fractured  Alveolar  Bone  —  Use  local  anesthesia/analgesics/antibiotics  (usually 
penicillin  if  not  otherwise  contraindicated).  Debride  the  area  of  any  small 
loose  bone  chips  or  spicules.  Do  not  remove  larger  pieces  of  alveolar  bone  that 
are  intimately  covered  with  soft  tissue.  Gently  pinch  or  mold  the  fractured 
alveolar  bone  through  the  gingival/mucosal  tissues.  Suture  any  lacerations  and 
attempt  to  stabilize  the  bone  by  splinting  teeth  in  the  mobile  segment  with 
adjacent  teeth  using  floss/light  wire/suture/or  fishline.  Monitor  closely  for 
possible  infection.  MEDEVAC  may  be  necessary. 

Fractured  Mandible  —  Maintain  airway  function  and  control  bleeding.  Support  the 
patient’s  vital  signs.  Use  analgesics/antibiotics  (usually  penicillin  if  not 
otherwise  contraindicated.  Debride  and  irrigate  any  lacerations.  Loosely 
approximate  the  wound  edges  with  tacking  sutures  but  do  not  attempt  definitive 
soft  tissue  closure  if  the  laceration  coexists  with  facial  fractures.  Close 
through-and-through  lacerations  with  a  watertight  closure  of  the  oral  mucosa 
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followed  by  a  layered  closure  to  the  skin.  Improper  use  of  external 
immobilization  bandages  is  dangerous  and  can  further  embarrass  the  airway. 
MEDEVAC  the  patient  as  soon  as  possible. 

Fractured  Maxilla  —  Maintain  airway  and  control  bleeding  (temporary  nasal 
packing  may  be  needed).  Support  the  patient’s  vital  signs.  Use 
analgesics/antibiotics  (usually  penicillin  unless  otherwise  contraindicated). 

Debride  and  irrigate  any  lacerations.  Loosely  reapproximate  the  wound  edges 
with  tacking  sutures  but  do  not  attempt  definitive  soft  tissue  closure  if  the  laceration 
coexists  with  facial  fractures.  Close  through-and-through  lacerations  with  a 
watertight  closure  of  the  oral  mucosal  followed  by  a  layered  closure  to  the 
skin.  The  improper  use  of  external  immobilization  bandages  is  dangerous  and 
can  further  embarrass  the  airway.  MEDEVAC  the  patient  in  a  head-up  or  lateral 
prone  position. 

Fractured  Facial  Bones  --  Maintain  the  airway  and  control  bleeding.  Support 
vital  signs.  Use  analgesics/antibiotics  (usually  penicillin  unless  otherwise 
contraindicated).  Debride  and  irrigate  any  lacerations.  Loosely  reapproximate 
the  wound  edges  with  tacking  sutures  but  do  not  attempt  definitive  soft 
tissue  closure  if  the  laceration  coexists  with  facial  fractures.  Close 
through-and-through  lacerations  with  a  watertight  closure  of  the  oral  mucosa 
followed  by  a  layered  closure  to  the  skin.  Evaluate  ocular  function  and 
orbital/periorbital  trauma.  Check  for  paresthesias  in  infra-  and  supraorbital 
regions.  MEDEVAC  the  patient  in  a  head-up  or  lateral  prone  position. 

Neurologic  Injury  —  Maintain  the  airway  and  control  bleeding.  Support  vital 
signs.  Perform  neurologic  examination  and  assess  the  level  of  consciousness. 
Assess  the  posture  and  movements  and  reflexes.  Evaluate  eye  movements  and 
pupils.  Evaluate  the  gross  focal  neurological  deficit  Determine  the  cause 
and  time  of  injury  and  whether  there  are  any  associated  injuries/shock/hypoxemia/ 
or  other  medical  complications.  MEDEVAC  is  usually  indicated. 
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Appendix  E 

User  Library  File  Listings 


DEFRTNS.BAS 


REM  The  definition  and  window  routines  for  DENT AL  and  DIFF  are  contained 
in  this  module. 

REM  This  module  was  modified  last  on  2123189  by  Cindy  Burgess-Russotti 
DEFINT  A-Z 

DIM  WINDscratt(5),  WINDframatt(5),  WINDheader$(5) 

DIM  WINDrow(5),  WINDcol(5),  WINDheight(5),  WINDwidth(5) 

DIM  wind%(2000, 5) 

DIM  WINDrowptr(5),  WINDcolptr(5)  ’  UL  corner  of  frame 

DIM  dindx(120, 2),  item$(120),  disease$(34),  disindx(34, 2) 

DIM  option$(10, 2),  opline(lO) 

DIM  response(92),  z(35),  corpresp(36) 

REM  include  common  statements  for  all  modules 

rem  $include:  ’dentcomm.bas’ 
rem  $include:  ’windcomm.bas’ 

Subroutine  UCASE 

called  from:  DEFINITIONROUTINE 

This  routine  converts  a  string  from  lower  case  to  upper  case. 

SUB  UCASE(x$)  STATIC 
length=LEN(x$) 

IF  length  =o  THEN 
x$="" 

ELSE 

FOR  i=l  TO  length 
ch=ASC(mid$(x$,  i,  1)) 

IF  ch96  AND  ch  THEN 
MID$(x$,  i,  l)=CHR$(ch-32) 

END  IF 
NEXT  i 
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END  IF 
END  SUB 

Subroutine  CLEARWINDOW 

called  from:  DEFINITIONROUTINE,  MAKEWINDOW DEFrNmONROUTINE2 , 
DISEASEDEFINITION  S ,  PRIDISEASEDEFS. 
calls:  SCROLLUP 

This  routine  clears  the  current  window  of  text 

SUB  clearwindow  STATIC 

wno  =  WINDcument 

lur  =  WINDrow(wno)  +  1 

luc  =  WINDcol(wno)  +  1 

rlr  =  WINDrow(wno)  +  WINDheight(wno)  -  2 

rlc  =  WINDcol(wno)  +  WINDwidth(wno)  -  2 

attr  =  WINDscratt(wno) 

linewidth  =  WINDwidth(wno)  -  2 

scrollines  =  0 

CALL  scrollup  Our,  luc,  rlr,  rlc,  scrollines,  attr) 

WINDrowptr  =  1 
WINDcolptr  =  1 
END  SUB 

Subroutine  COMPUTEROWCOL 

called  from:  DEFINITIONROUTINE,  DISEASEDEFINITIONS 
This  routine  computes  the  relative  row  and  column  for  item$(counter). 

SUB  computerowcol  (counter,  row,  col)  STATIC 

numline  =  WINDheight(WINDcurrent)  -  2 

modecount  =  (counter  -  1 )  MOD  numline 

row  =  modecount  +  1 

’IF  row  =  0  THEN  row  =  numline 

col  =  INT((counter  - 1)  /  numline)  *25+1 

END  SUB 

Subroutine  DEFINITIONROUTINE 
called  from:  main  program  (DENTAL) 

calls:  PUSHWINDOW,  WLOCATE,  WPRINT,  UCASE,  FPRINT,  COMPUTEROWCOL, 
HELPDEFINTTION S ,  REMOVEWINDOW,  CLEARWINDOW. 

This  routine  is  called  when  the  user  selects  term  definitions  from  the 
definition  menu.  All  the  words  that  can  be  defined  are  displayed  in  a 
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window  on  the  screen.  The  user  can  then  use  the  direction  keys  to 
highlight  the  word  he  wants  to  have  defined  or  he  can  type  it  on  the 
command  line  at  the  bottom  of  the  screen.  Once  the  word  is  selected,  a 
window  is  created  and  the  definition  is  displayed  in  the  window. 

SUB  definitionroutine  STATIC 
defint  a-z 


’make  window  and  throw  items  in  window 

’routine  to  move  cursor  and  update  bottom  command  line. 

’select  item 

’clean  up  and  exit 


attr%  =  7 

’This  window  in  effect  acts  as  a  CLS  statement,  which  can  print  outside  the 
definition  list  window  without  overprinting  other  stuff 

CALL  pushwindow(attr%,  0, 1, 1, 25,  80) 

’  This  window  is  the  actual  definition  selection  window. 

CALL  pushwindow(attr%,  selectlf,  "Definition  Selection",  4, 4, 15, 75) 

'  compute  normal  attribute  and  inverse  of  it. 

nl  =  WINDscratt(WINDcurrent) 

nlfor  =  nl  MOD  16 

nlbak  =  INT(nl  /  16) 

inverse  =  nlfor  *  16  +  nlbak 

frame  =  abs(WINDframatt(WINDcurrent)) 
fg  =  frame  MOD  1 6 
bg  =  INT(frame  /  16) 

’  show  command  line 
LOCATE  24,  5,  0 
PRINT  "Definition "; 

’  Print  directions 

locate  25, 1  :color  defkeyline,  defkeyline:print  space$(80); 
locate  25,  3:color  normal,  bground:print "  Esc  ";:color  defkeylettr, 
defkeyline:print Quit"; 

locate  25, 40:color  normal,  bgroundrprint "  PgDn  ";:color  defkeylettr, 
defkeyline:print Next  Page"; 

locate  25,  58:color  normal,  bground:print "  PgUp  ";:color  defkeylettr, 
defkeyline:print Previous  Page"; 
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color  normal,  bground 
page=l 

printncwpage: 

locate  18,  35:color  fg,  bgrprint  "Page";page;"  of  2";:color  normal,  bground 
if  page=l  then 
firstword=l 
lastword=39 
else 

firstword=40 
lastword=77 
end  if 

counter  =  firstword  ’Print  terms  on  screen 

FOR  c  =  1  TO  78  STEP  25 
FOR  r  =  1  TO  13 
CALL  wlocate(r,  c) 

if  len(item$(counter))  23  then  ’Ifitem$  is  too  long,  print  the 
leftmost  23  characters 

CALL  wprint(left$(item$(counter),  23))  else 

CALL  wprint(item$(counter)) 
end  if 

counter  =  counter  +  1 
IF  counter  lastword  THEN  EXIT  FOR 
NEXT  r 

IF  counter  lastword  THEN  EXIT  FOR 
NEXT  c 

initialize  certain  variables 

counter  =  firstword  '  number  of  word  highlighted 

localrow  =  1  ’coordinates  relative  to  window 

localcol  =  1 

commanditem$  =  item$(counter)  ’word  typed  on  command  line 
call  ucase  (commanditem$) 

commandptr  =  LEN(commanditem$)  ’string  pointer  for  word  on  command  line 
anowflag  =1  -l  if  arrow  key  was  last  pressed 

REM  Highlight  first  word  on  screen 

CALL  wlocate(  localrow,  localcol) 
if  len(item$(counter))  23  then 
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.  CALL  fprint(left$(i  tem$(counter) ,  23),  inverse) 

F  else 

CALL  fprint(item$(counter),  inverse) 
end  if 

LOCATE  24, 17 

CALL  fprint(item$(counter) ,  inverse) 

LOCATE  24, 17  +  commandptr,  1 

REM  Get  input  from  user 

DO 

DO 

a$  =  INKEY$ 

LOOP  WHILE  a$  =  ’"' 

IF  LEN(a$)  =  2  THEN  ’arrow  keys  or  pgup,  pgdn  pressed 

CALL  wlocate  (localrow,  localcol) 
if  len(item$(counter))  23  then 
CALL  fprint(left$(item$(counter),  23),  nl) 
else 

CALL  fprint(item$(counter),  nl) 
end  if 

|  code2key  =  ASC(RIGHT$(a$,  1 )) 

SELECT  CASE  ccxie2key 
CASE  72  ’up  arrow 
counter  =  counter  - 1 

IF  counter  firstword  THEN  counter  =  lastword 

CASE  80  'down  arrow 
counter  =  counter  +  1 

EF  counter  lastword  THEN  counter  =  firstword 
CASE  75  ’  left  arrow 

IF  (page=l  and  counter  14)  or  (page=2  and  counter  53)  THEN 
counter  =  counter  +  26 

IF  counter  lastword  THEN  counter  =  lastword 
ELSE 

counter  =  counter  -  13 
END  IF 

CASE  77  ’right  arrow 
if  page=l  then 
SELECT  CASE  counter 


I 
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CASE  1  TO  25 
counter  =  counter  +  1 3 
CASE  26 
counter  =  lastword 
CASE  27  TO  39 
counter  =  counter  -  26 
END  SELECT 
else 

SELECT  CASE  counter 
CASE  40  TO  64 
counter  =  counter  +  1 3 
CASE  65 
counter  =  lastword 
CASE  66  TO  78 
counter  =  counter  -  26 
END  SELECT 
end  if 


CASE  7 1  ’home  arrow 
counter  =  firstword 

CASE  79  ’end  arrow 

counter  =  lastword 

CASE  73  ’PgUp 

if  page  =  2  then 
page=l 
end  if 

CASE  81  ’PgDn 

if  page  =  1  then 
page=2 
end  if 

CASE  ELSE 
BEEP 

END  SELECT 

REM  If  page  up  or  page  down  was  pressed,  then  blank  out  command  line, 
otherwise  highlight  word  that  corresponds  with  counter. 

if  (code2key  =  73)  or  (code2key  =  81)  then  ’PgUp  or  PgDn 
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LOCATE  24, 17 

CALL  fprint(space$(50),  nl) ' Blank  out  command  line 
else 

CALL  computerowcol(counter  -  firstword  +  1 ,  localrow,  localcol) 
CALL  wlocate  (localrow,  localcol) 
if  len(item$(counter))  23  then 
CALL  fprint(left$(item$(counter),  23),  inverse) 
else 

CALL  fprint(item$(counter),  inverse) 
end  if 

REM  Print  highlighted  word  on  command  line 

LOCATE  24,  17 

CALL  fprint(space$(50),  nl) 

CALL  fprint(item$(counter),  inverse) 
commanditem$  =  item$(counter) 
call  ucase(commanditem$) 
commandptr  =  LEN(commanditem$) 

LOCATE  24, 17  +  commandptr,  1 
arrowflag  =  1 
end  if 

REM  User  entered  a  letter  or  blank  at  command  line 

ELSE 
’other  keys 
call  UCASE  (a$) 

SELECT  CASE  ASC(LEFT$(a$,  1)) 

CASE  32, 48  TO  57, 65  TO  90  ' alphanumerics  and  blank 

IF  arrowflag  =  1  THEN 
arrowflag  =  0 
commanditem$  =  "" 
commandptr  =  0 
LOCATE  24,  17 
CALL  fprint(space$(50),  nl) 

END  IF 

commanditem$  =  commanditemS  +  a$ 
commandptr  =  commandptr  +  1 
if  commandptr  63  then 
commandptr=63 
beep 
end  if 

LOCATE  24,  16  +  commandptr 
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CALL  fprint(a$,  inverse) 

LOCATE  24, 17  +  commandptr,  1 

CASE  8  ’backspace!  delete 

IF  arrowflag  =  1  THEN  arrowflag  =  0 
commandptr  =  commandptr  - 1 
IF  commandptr  0  THEN  commandptr  =  0 
LOCATE  24, 17  +  commandptr,  1 
CALL  fprintf  ",  nl) 

commanditemS  =  LEFT$(commanditem$,  commandptr) 

CASE  27  ’Esc  to  exit 

LOCATE  24,  17 
CALL  fprint("  ",  inverse) 

CASE  13  ’CR  to  accept 

IF  arrowflag  =  0  THEN 
oldcounter=counter 
counter  =  0 
FOR  i  =  1  TO  77 
tempitem$=item$(i) 
call  UCASE  (tempitem$) 

IF  commanditemS  =  tempitem$  THEN 
CALL  computerowcol(oldcounter  -  firstword  +  1,  localrow,  localcol) 
CALL  wlocate  (localrow,  localcol) 
if  len(item$(oldcounter))  23  then 
CALL  fprint(left$(item$(oldcounter),  23),  nl) 
else 

CALL  fprint(item$(oldcounter),  nl) 
end  if 
counter  =  i 
end  if 
NEXT  i 
END  IF 

IF  counter  =  0  THEN 
locate  24, 17, 0 

call  fprint("NO  MATCH  FOR  "+commanditem$,  inverse) 

BEEP 

pause!=timer+.75 
do  while  timer  pause! 
loop 

counter=oldcounter 

LOCATE  24,  17 

CALL  fprint(space$(50),  nl) 

CALL  fjprint(item$(counter),  inverse) 
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commanditem$  =  item$(counter) 
call  ucase(commanditem$) 
commandptr  =  LEN(commanditem$) 

LOCATE  24, 17  +  commandptr,  1 

ELSE 

if  arrowflag=0  then 

CALL  computerowcol(counter  -  firstword  +  1 ,  localrow,  localcol) 
CALL  wlocate  (localrow,  localcol) 
if  len(item$(counter))  23  then 
CALL  fprint(left$(item$(counter),  23),  inverse) 
else 

CALL  fprint(item$(counter),  inverse) 
end  if 

commandptr  =  LEN(commanditem$) 
end  if 

CALL  helpdefinitions(counter,  item$(counter))  ’Print  definition  of  word 
LOCATE  24,  17  +  commandptr,  1 
END  IF 
arrowflag  =  1 

CASE  ELSE 
BEEP 

END  SELECT 
END  IF 

REM  loop  until  Esc,  PgDn  or  PgUp 

LOOP  UNTIL  a$  =  CHR$(27)  or  (code2key=8 1 )  or  (code2key=73) 
code2key=0 
if  a$=chr$(27)  then 

CALL  remove  window  'containing  definition  list 

CALL  removewindow  '  blank  window 
LOCATE , ,  0 
else 

call  clearwindow 
goto  printnewpage 
end  if 

END  SUB 
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Subroutine  EXPLODE 

called  from:  MAKEWINDOW 

calls:  SCROLLUP,  EXPLOSION,  DUD 

This  routine  explodes  the  window  onto  the  screen. 

SUB  explode  (wno)  STATIC 

tlr  -  top  left  hand  corner  of  the  window  frame . 
tic  -  top  left  hand  column  of  the  window  frame, 
numline  -  number  of  lines  (rows)  in  the  window, 
numcol  -  number  of  columns  in  the  window. 

’  NOTE:  numline  and  numcol  include  the  window  frame,  tlr  and  tic  are 
coordinates  for  the  top  left  hand  comer  of  the  frame. 


DEFINT  A-Z 

tlr  =  WINDrow(wno) 
tic  =  WTNDcol(wno) 
numline  =  WINDheight(wno) 
numcol  =  WINDwidth(wno) 
title$  =  WINDheaderS(wno) 
screenattr  =  WINDscratt(wno) 
frameattr  =  WINDframatt(wno) 

IfFrameattr  =  0  Blank  window 
’  If  Frameattr  0  Print  expoding  frame 
’  IfFrameattr  0  Don’t  print  expoding  frame 

No  need  to  draw  window  if  window  is  blank. 

IF  frameattr  =  0  THEN 
rlr  =  WINDrow(wno)  +  WINDheight(wno) 
rlc  =  WINDcol(wno)  +  WIND  width  (wno) 
scrollines  =  0 

CALL  scrollup  (tlr,  tic,  rlr,  rlc,  scrollines,  screenattr) 
ELSEIF  frameattr  0  then 
'  Print  exploding  frame 

CALL  explosion(tlr,  tic,  numline,  numcol,  frameattr) 
else 

’  Don’ t  print  exploding  frame 
CALL  dud  (tlr,  tic,  numline,  numcol,  frameattr) 
end  if 

if  frameattr  0  then 
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Print  heading  on  window  frame. 
oklen  =  numcol  -  2 
okstartcol  =  tic  +  1 
title$  =  MID$(title$,  1,  oklen) 
titlelen  =  LEN(title$) 
surplus  =  oklen  -  titlelen 
titleoffset  =  INT(surplus  /  2) 

LOCATE  tlr,  okstartcol  +  tit'eoffset 
CALL  fprint(title$,  frameattr) 

END  IF 

END  SUB 

Subroutine  EXPLOSION 
called  from:  EXPLODE 
calls:  FPRINT 

This  routine  draws  the  exploding  window  using  the  following: 
ulrow  -  upper  left  row  of  window  (includes  frame), 
ulcol  -  upper  left  column  of  window  (includes  frame), 
numline  -  number  of  rows  in  the  window  (includes  frame), 
numcol  -  number  of  columns  in  the  window  (includes  frame), 
frameattr  -  attribute  of  frame. 

SUB  explosion  (ulrow,  ulcol,  numline,  numcol,  frameattr)  STATIC 

maxline  =  numline  -  2 

maxcol  =  numcol  -  2 

startrow  =  ulrow  +  INT(numline  /  2) 

started  =  ulcol  +  INT(numcol  /  2) 

horiz  =  -2 

vert  =  -2 

del  taro  w  =  startrow 
deltacol  =  startcol 
DO 

horiz  =  horiz  +  2 

IF  horiz  maxcol  THEN  horiz  =  maxcol 
vert  =  vert  +  2 

IF  vert  maxline  THEN  vert  =  maxline 
deltarow  =  deltarow  -  1 
IF  deltarow  ulrow  THEN  deltarow  =  ulrow 
deltacol  =  deltacol  -  1 
IF  deltacol  ulcol  THEN  deltacol  =  ulcol 
topbufferS  =  STRING$(horiz,  196) 
buffer$  =  SPACES(horiz) 
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topstringS  =  CHR$(218)  +  topbuffer$  +  CHR$(191) 
botstring$  =  CHR$(192)  +  topbuffer$  +  CHR$(217) 
midstring$  =  CHR$(179)  +  buffer$  +  CHR$(179) 

LOCATE  deltarow,  deltacol 
CALL  fprint(topstring$,  frameattr) 

FOR  dummy  =  1  TO  vert 
LOCATE  deltarow  +  dummy,  deltacol 
CALL  fprint(midstring$,  frameattr) 

NEXT  dummy 

LOCATE  deltarow  +  vert  +  1 ,  deltacol 
CALL  fprint(botstring$,  frameattr) 

LOOP  UNTIL  vert  =  maxline  AND  horiz  =  maxcol 

END  SUB 

Subroutine  DUD 
called  from:  EXPLODE 
calls:  FPRINT 

This  routine  draws  the  window  without  exploding  using  the  following: 
ULROW  -  upper  left  row  of  window  (includes  frame). 

ULCOL  -  upper  left  column  of  window  (includes  frame). 

NUMLINE  -  number  of  rows  in  the  window  (includes  frame). 
NUMCOL  -  number  of  columns  in  the  window  (includes  frame). 
FRAMEATTR  -  attribute  for  frame  (starts  out  as  negative  number). 

SUB  dud  (ulrow,  ulcol,  numline,  numcol,  frameattr)  STATIC 
frameattr  =  abs  (frameattr) 
startrow  =  ulrow 
started  =  ulcol 
horiz  -  numcol  -  2 
vert  =  numline  -  2 
topbuffer$  =  STRING$(horiz,  196) 
buffer$  =  SPACE$(horiz) 

topstring$  =  CHR$(218)  +  topbuffer$  +  CHR$(191) 
botstring$  =  CHR$(192)  +  topbuffer$  +  CHR$(217) 
midstring$  =  CHR$(179)  +  buffer$  +  CHR$(179) 

LOCATE  startrow,  startcol 
CALL  fprint(topstring$,  frameattr) 

FOR  dummy  =  1  TO  vert 
LOCATE  startrow  +  dummy,  startcol 
CALL  fprint(midstring$,  frameattr) 

NEXT  dummy 

LOCATE  startrow  +  vert  +  1 ,  startcol 
CALL  fprint(botstring$,  frameattr) 
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END  SUB 


Subroutine  HELPDEFINITIONS 

called  from:  DEFINITIONROUTINE 

calls:  PUSHWINDOW,  REMOVE  WINDOW 

This  routine  creates  a  window  and  displays  a  definition  in  it. 


SUB  helpdefmitions  (counter,  item$)  STATIC 


field#l,  60  as  records 
lir»elimit=60:defcol=l:linecount=2 

titleS  =  "Definition  cf  ”  +  item$ 

CALL  pushwindow(defls,  deflf,  titleS,  8,  10, 10,  62) 

'  routine  to  get  definition  string. 

r=dindx(counter,  1) 
for  r2  =  r  to  r+dindx(counter,  2)-l 
get#l,r2 

call  wlocateOinecount,  defcol) 
call  wprint  (recordS) 
linecount=linecount+ 1 
next  r2 

scm=WINDscratt(WINDcurrent) 
fg  =  scm  mod  16 
bg  =  int(scm  /  16) 

locate  16,  24:color  fg,  bg:print  "Press  any  key  to  continue. ,.";:color  normal, 
bground 
a$  =  INPUT$(1) 

CALL  removewindow 

END  SUB 

Subroutine  MAKEWINDOW 

calls:  SETWINDOWDEFS,  WINDOWSAVE,  EXPLODE,  SHIFTWINDOW 

This  procedure  creates  the  window. 

wno  =  window  number,  used  to  identify  the  window. 

s  =  screen  attribute  for  within  the  window. 
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f  =  attribute  for  frame. 

h$  =  title  which  is  centered  and  printed  on  the  top  frame  line, 
r  =  top  left  row  number  (actually  points  to  comer  of  frame), 
c  =  top  left  column  number  (actually  points  to  comer  of  frame), 
h  =  height  of  window,  including  frame  itself, 
w  =  width  of  window,  including  frame  itself. 


SUB  makewindow  (wno,  s,  f,  h$,  r,  c,  h,  w)  STATIC 
lurf  =  r  +  1 
lucf  =  c  +  1 
rlrf  =  r  +  h  -  1 
rlcf  =  c  +  w  - 1 

IF  lurf  1  OR  lucf  1  OR  rlrf  25  OR  rlcf  80  THEN 
CLS 

PRINT  "Attempting  to  draw  window  number  wno;  "is  illegal." 
BEEP 
STOP 
END  IF 


’get  rid  of  cursor 
LOCATE , ,  0 

'update  global  window  variables 

CALL  setwindowdefs(wno,  s,  f,  h$,  r,  c,  h,  w) 

’save  background 
CALL  windowsave(wno) 

’draw  frame 
CALL  explode(wno) 

’put  cursor  in  the  top  left  corner  of  writable  region  of  window  and 
’restore  blinking  aspect. 

LOCATE  r  +  1 , c  + 1 ,  1 
CALL  shiftwindow(wno) 

CALL  clearwindow 
END  SUB 

Subroutine  PUSHWINDOW 

called  fromiDEFINITIONROUTINE,  DEFINITIONROUTINE2,  DISE ASEDEFINITION S 
calls:  MAKEWINDOW 
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This  routine  is  like  makewindow,  except  that  you  don’t  have 

to  keep  track  of  the  window  number.  Just  be  sure  that  you  do  not  use 

more  than  five  windows  at  one  time. 

s  =  screen  attribute  for  within  the  window. 

f  =  attribute  for  frame.  If  a  negative  number  the  window  will  not 

explode. 

h$  =  title  which  is  centered  and  printed  on  the  top  frame  line, 
r  =  top  left  row  number  (actually  points  to  comer  of  frame), 
c  =  top  left  col  number  (actually  points  to  comer  of  frame), 
h  =  height  of  window,  including  frame  itself, 
w  =  width  of  window,  including  frame  itself. 


SUB  pushwindow  (s,  f,  h$,  r,  c,  h,  w)  STATIC 
wno  =  WTNDcurrent  +  1 
CALL  makewindow(wno,  s,  f,  h$,  r,  c,  h,  w) 

END  SUB 

Subroutine  REMOVEWINDOW 

called  from:  DEFINITIONROUTINE,  HELPDEFINITIONS,  DEFINITIONROUTINE2, 

DISEASEDEFINITION  S 

calls:  WINREST,  SHIFTWINDOW 

This  routine  removes  the  current  window  and  restores  the  screen 
beneath  it  It  also  decrements  WINDcurrent  so  that  the 
previous  window  is  the  current  one.  WINDcurrent=0  if  no 
windows  exist. 


SUB  removewindow  STATIC 

wno  =  WINDcurrent 
tlr  =  WINDrow(wno) 
tic  =  WTNDcol(wno) 
numline  =  WINDheight(wno) 
numcol  =  WINDwidth(wno) 

’  QB  3.0  routine 

CALL  ptr86( segment,  offset,  VARPTR(wind%(0,  wno))) 

CALL  winrest(segment,  offset,  tlr,  tic,  numcol,  numline) 

’  QB  4.0  routine 

’  CALL  winrest(VARSEG(wind%(0,  wno)),  VARPTR(wind%(0,  wno)),  tlr,  tic, 
numcol,  numline) 


I 
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wno  =  wno  - 1 
IF  wno  0  THEN  wno  =  0 
CALL  shiftwindow(wno) 
END  SUB 


Subroutine  SETWINDOWSDEFS 

called  from:  MAKEWINDOW,  PUSHWINDOW 

This  procedure  sets  the  global  variables. 


SUB  setwindowdefs  (wno,  s,  f,  h$,  r,  c,  h,  w)  STATIC 

WINDscratt(wno)  =  s 
WINDframatt(wno)  =  f 
WINDheader$(wno)  =  h$ 

WINDrow(wno)  =  r 
WINDcol(wno)  =  c 
WINDheight(wno)  =  h 
WINDwidth(wno)  =  w 
WINDcurrent  =  wno 
WTNDrowptr(wno)  =  1 
WINDcolptr(wno)  =  1 
END  SUB 

Subroutine  SHIFTWINDOW 
called  from:  MAKEWINDOW,  REMOVEWINDOW 
This  routine  shifts  to  current  window  wno.  If  wno=0  then 
the  whole  screen  80X25  is  used. 

SUB  shiftwindow  (wno)  STATIC 

IF  wno  0  OR  wno  5  THEN  wno  =  0 
WINDcurrent  =  wno 
IF  wno  0  THEN 

WINDcurrentrow  =  WTNDrowptr(wno) 

WINDcurrentcol  =  WINDcolptr(wno) 

END  IF 
END  SUB 

Subroutine  WINDOWSAVE 
called  from:  MAKEWINDOW 
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Calls:  WINSAVE 

This  routine  saves  the  background  screen  beneath  the  upcoming  window. 


SUB  windowsave  (wno)  STATIC 

tlr  =  WINDrow(wno) 
tic  =  WINDcol(wno) 
numline  =  WINDheight(wno) 
numcol  =  WINDwidth(wno) 


’  QB  3.0  routine 

CALL  ptr86(segment,  offset,  VARPTR(wind%(0,  wno))) 

CALL  winsave(segment,  offset,  tlr,  tic,  numcol,  numline) 

’  QB  4.0  routine 

’  CALL  winsave(VARSEG(wind%(0,  wno)),  VARPTR(wind%(0,  wno)),  tlr,  tic, 
numcol,  numline) 

END  SUB 

Subroutine  WLOCATE 

called  from:  DEFINITIONROUTINE,  HELPDEFINITIONS,  DEFINmONROUTINE2, 

DISEASEDEFINITIONS,  PRIDISEASEDEFS 

This  routine  acts  like  locate,  except  that  all  locations 

are  relative  to  the  current  window.  The  top  left  comer  of  the  window 

(not  including  frame)  would  be  1 ,  1 . 


SUB  wlocate  (row,  col)  STATIC 
wno  =  WINDcurrent 
lur  =  WINDrow(wno)  +  1 
luc  =  WINDcol(wno)  +  1 
rlr  =  WTNDrow(wno)  +  WINDheight(wno)  -  2 
rlc  =  WINDcol(wno)  +  WINDwidth(wno)  -  2 
'  Check  if  a  window  is  open. 

IF  wno  0  THEN 
physrow  =  row  +  lur  -  1 
IF  physrow  rlr  THEN  physrow  =  rlr 
physcol  =  col  +  luc  -  1 
IF  physcol  rlc  THEN  physcol  =  rlc 
ELSE 

physrow  =  row 
physcol  =  col 
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END  IF 

LOCATE  physrow,  physcol,  0 

END  SUB 

Subroutine  WPRINT 

called  from:  DEF1NITIONROUTINE 

calls:  FPRINT 

This  routine  prints  text$  wthin  the  current  window. 


SUB  wprint  (text$)  STATIC 

wno  =  WINDcurrent 

lur  =  WINDrow(wno)  +  1 

luc  =  WINDcol(wno)  +  1 

rlr  =  WTNDrow(wno)  +  WINDheight(wno)  -  2 

rlc  =  WINDcol(wno)  +  WIND  width  (wno)  -  2 

attr  =  WINDscratt(wno) 

linewidth  =  WINDwidth(wno)  -  2 

’will  add  stuff  later.  For  now,  just  use  /print. 

CALL  fprint(text$,  attr) 

END  SUB 

Subroutine  WSCROLLPRINT 
Calls:  scrollup 

This  routine  prints  a  string  of  text  in  the  current  window  scrolling  as 
necessary. 

SUB  wscrollprint  (text$)  STATIC 

wno  =  WINDcurrent 

lur  =  WINDrow(wno)  +  1 

luc  =  WINDcol(wno)  +  1 

rlr  =  WINDrow(wno)  +  WINDheight(wno)  -  2 

rlc  =  WINDcol(wno)  +  WTNDwidth(wno)  -  2 

attr  =  WINDscratt(wno) 

linewidth  =  WINDwidth(wno)  -  2 

scrollines  =  1 

CALL  scrollup  (lur,  luc,  rlr,  rlc,  scrollines,  attr) 

IF  LEN(textS)  linewidth  THEN 
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WHILE  LEN(tcxt$)  linewidth 
newtext$  =  LEFT$(text$,  linewidth) 
text$  =  RIGHT$(text$,  LEN(text$)  -  linewidth) 

CALL  scrollup  (lur,  luc,  rlr,  rlc,  scrollines,  attr) 

LOCATE  rlr,  luc,  0 
CALL  fprint(newtext$,  attr) 

WEND 
END  IF 

IF  LEN(text$)  OTHEN 
CALL  scrollup  (lur,  luc,  rlr,  rlc,  scrollines,  attr) 

LOCATE  rlr,  luc,  0 
CALL  fprint(text$,  attr) 

END  IF 

END  SUB 

Subroutine  DEFINIT10NR0UT1NE2 
called  from:  GETRESP,  TRTRESP,  PRESSRET,  GETRESP2 
calls:  PUSHWINDOW,  FPRINT,  UCASE,  WLOCATE,  CLEARWINDOW, 
REMOVEWINDOW 

In  this  routine,  a  window  is  created  where  the  user  can  enter  a  word  he 
wants  to  have  defined.  A  second  window  is  created  where  the 
corresponding  definition  is  displayed. 

SUB  definitionroutine2  STATIC 
defint  a-z 

dim  defptr(lOO),  startrec(40),  endrec(40) 
pagelimit=5 

selectrow=  1 8  :selectcol= 1 0:selecthth=5 :  selectwid=62 
field#  1, 60  as  records 

CALL  pushwindow(select2s,  select2f,  "Definition  of  Terms",  selectrow, 
selectcol,  selecthth,  selectwid) 
nl  =  WINDscratt(WINDcurrent) 
nlfor  =  nl  MOD  16 
nlbak  =  INT(nl/ 16) 
inverse  =  nlfor  *  16  +  nlbak 
locate  selectrow+selecthth-1,  selectcol+26 
call  fprintf'Esc  -  Quit",  abs(select2f)) 
searchdef$="" 
searchdefptr=0 
ptrcounter  =  1:  numlines  =  0 
call  wlocate  (2,  5) 
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call  fprint  ("Enter  letter(s)  or  word  ",  select2s) 
locate  selectrow+2,  selectcol+29  +  searchdefptr,  1 

do 

do 

z$=inkey$ 
loop  while  z$="" 

call  UCASE  (z$) 

SELECT  CASE  ASC(LEFT$(z$,  1)) 

CASE  48  TO  57, 65  TO  90  '  alphanumerics 

searchdef$  =  searchdefS  +  z$ 
searchdefptr  =  searchdefptr  +  1 

if  searchdefptr  32  then  'word  can  t  be  longer  than  32  characters 
searchdefptr=32 
beep 
end  if 

locate  selectrow+2,  selectcol+28  +  searchdefptr 
CALL  fprint(z$,  inverse) 

locate  selectrow+2,  selectcol+29  +  searchdefptr,  1 

CASE  8  ’backspace! delete 

searchdefptr  =  searchdefptr  - 1 
IF  searchdefptr  0  THEN  searchdefptr  =  0 
locate  selectrow+2,  selectcol+29  +  searchdefptr,  1 
CALL  fprint("  ",  nl) 

searchdefS  =  LEFT$(searchdef$,  searchdefptr) 

CASE  27  'Esc  to  exit 

locate  selectrow+2,  selectcol+29 
CALL  fprint(space$(32),  nl) 

CASE  13  ’CR  to  accept 

if  searchdefS  ""  then 

for  defcounter  =  1  to  1 10  'look  for  a  match 

if  (defcounter=52)  or  (defcounter=54)  or  (defcounter=59)  or 
(defcounter=74)  then  'These  words  must  be  an  exact  match  (Necrotizing, 
Occlusal  surface.  Periodontic  and  Ulcerated). 
tempdefS=item$(defcounter) 
call  ucase(tempdefS) 
if  searchdef$=tempdef$  then 
defptr(ptrcounter)=defcounter 
ptrcounter  =  ptrcounter  +  1 
numlines  =  numlines  +  dindx(defcounter,  2) 
end  if 
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else 

tempdef$=left$(item$(defcounter),  len(searchdef$)) 
call  ucase(tempdef$) 
if  searchdef$=tempdef$  then 
defptr(ptrcounter)=defcounter 
ptrcounter  =  ptrcounter  +  1 
numlines  =  numlines  +  dindx(defcounter,  2) 
end  if 
end  if 

next  defcounter 
numofwoids  =  ptrcounter  -  1 


IF  numofwoids  =  0  THEN  ’no  match 
nomatch$="No  Match  for  "+searchdef$ 
locate  selectrow+3,  selectcol  +  int((60-len(nomatch$))/2),  0 
call  fprint(nomatch$,  nl) 
pause  !=timer+.75 
do  while  timer  pause! 
loop 
BEEP 

locate  selectrow+3,  seIectcoI+int((60-len(nomatch$))/2) 
call  fprint(space$(len(nomatch$)),  nl) 

ELSE 

if  numlines  pagelimit  then 

’ Determine  how  many  pages  of  definitions,  and  the  first  and  last  record  number 
for  each  page. 

numofpages  =  int(numlines/pagelimit) 
linesonlastpage=numlines  mod  pagelimit 
if  linesonlastpage  0  then 
numofpages=numofpages+ 1 
end  if 

linesonpage=pagelimit 

else 

numofpages=l 
linesonlastpage=0 
linesonpage=numlines 
end  if 

firstrec=dindx(defptr(l),  1) 

lastrec=dindx(defptr(numofwords),  l)+dindx(defptr(numofwords),  2)-l 
page=l 

startrec(page)=firstrec 

endrec(page)=startrec(page)+linesonpage-l 
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page=page+l 

do  while  page  numofpages 
startrec(page)=endrec(page- 1 )+ 1 
endrec(page)=startrec(page)+linesonpage- 1 
page=page+l 
loop 

if  linesonlastpage  Othen 
startrec(page)=endrec(page- 1 )+ 1 
endrec(page)=startrec(page)+linesonlastpage-l 
else 

startrec(page)=endrec(page- 1 )+ 1 
endrec(page)=startrcc(page)+linesonpage- 1 
end  if 

CALL  pushwindow  (def2s,  def2f, 5, 10,  linesonpage+3,  62) 
’Create  window  and  display 
locate  linesonpage+7, 15 

call  fprint  ("PgUp  -  Previous  Page  PgDn  -  Next  Page  Esc  -  Quit", 
abs(def2f)) 

color  normal,  bground 
page=  1 
do 

1=1  :c=l 

for  r=startrec(page)  to  endrec(page) 
get#l,r 

call  wlocatefl,  c) 

call  fprint  (records  ,  def2s) 

1=1+1 

nextr 

call  wlocate  (linesonpage+1, 48) 
whatpage$="Page"+str$(page)+"  of'+str$(numofpages) 
call  fprint  (whatpageS,  def2s) 
do 

z2$=inkey$ 
loop  while  z2$="" 
select  case  asc(right$(z2$,  1)) 
case  81  ’PgDn 

page=page+l 
case  73  ’PgUp 

page=page-l 
if  page  1  then 
page  =  1 
end  if 
case  else 

if  asc(z2$)  27  then 
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beep 
end  if 
end  select 

CALL  clearwindow 

loop  until  (page  numofpages)  or  (asc(z2$)=27) 
call  removewindow 
for  page=  1  to  numofpages 
startrec(page)=0 
endrec(page)=0 
next  page 
END  IF 

ptreounter  =  1 :  numlines  =  0 
searchdefS  =  "" 
searchdefptr  =  0 

locate  selectrow+2,  selectcol+29  +  searchdefptr 
call  fprint  (space$(32),  abs(select2s)) 
locate  selectrow+2,  selectcol+29  +  searchdefptr,  1 
else 
beep 
end  if 

CASE  ELSE 
BEEP 

END  SELECT 

loop  until  asc(right$(z$,  1))=27 
locate  , ,  0  ’turn  cursor  off 

call  removewindow 
END  SUB 

Subroutine  DISEASEDEFINITIONS 
called  from:  main  program  (DENTAL) 

calls:  PUSHWINDOW,  WLOCATE,  FPRINT,  PRIDISEASEDEFS 
This  routine  is  called  when  the  user  selects  disease  definitions  from 
the  definitions  menu.  All  33  diseases  are  displayed  in  a  window  on  the 
screen.  A  disease  is  selected  by  using  the  direction  keys  to  highlight 
it.  Once  the  disease  is  selected,  a  window  is  created  and  the 
corresponding  definition  is  displayed  in  it. 


SUB  diseasedefinitions  STATIC 
defint  a-z 

field#3, 60  as  records 
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attr%=7 

’make  window  and  throw  items  in  window 
’routine  to  move  cursor 
’select  item 
’clean  up  and  exit 

’This  window  in  effect  acts  as  a  CLS  statement,  so  that  can  print  outside 
’  the  definition  list  window  without  overprinting  other  stuff 
’  (locate  24,  x) 

CALL  pushwindow(attr%,  0, 1,  1, 25,  80) 

This  window  is  the  actual  definition  selection  window. 

CALL  pushwindow(attr%,  selectlf,  "Disease  Definition  Selection",  3,  1 1,  19, 
58) 


compute  normal  attribute  and  inverse  of  it. 
nl  =  WINDscratt(WINDcurrent) 
nlfor  =  nl  MOD  16 
nlbak  =  ENT(nl  /  16) 
inverse  =  nlfor  *  16  +  nlbak 

frame  =  abs(WINDframatt(WINDcurrent)) 
fg  =  frame  MOD  1 6 
bg  =  INT(frame  /  16) 

Print  directions 

locate  25,  1  rcolor  defkeyline,  defkeylinerprint  space$(80); 
locate  25,  3:color  normal,  bground:print "  Esc  ";:color  defkeylettr, 
defkeylineiprint "-  Quit"; 

locate  25,  40:color  normal,  bgroundrprint "  PgDn  ";:color  defkeylettr, 
defkeyline:print Next  Page"; 

locate  25,  58:color  normal,  bground:print "  PgUp  ";:color  defkeylettr, 
defkeyline:print Previous  Page"; 
color  normal,  bground 
page=l 

printnewpage2:  ’The  first  17  diseases  are  displayed  on  page  1 
if  page=l  then 
firstword=l 
lastword=17 
else 

firstword=18  ’The  rest  are  displayed  on  page  2 
lastword=34 
end  if 
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counter=0 

localrow=l 

localcol=l 

FOR  I  =firstword  TO  lastword  ’Display  diseases 
call  wlocate  (localrow,  localcol) 
call  fprint  (disease$(i),  nl) 
localrow=localrow+ 1 
NEXT  I 
locate  21,  33 

call  fprint("(Page  ”+right$(str$(page),  1)+"  of  2)",  abs(selectlf)) 
'  initialize  certain  variables 

counter  =  firstword  ’number  of  disease  highlighted 

localrow  =  1  ’coordinates  relative  to  window 

localcol  =  1 

CALL  wlocate  (localrow,  localcol) 

CALL  fprint(disease$(counter),  inverse) 

DO  ’allow  user  to  select 

DO 

a$  =  INKEY$ 

LOOP  WHILE  a$  =  "" 

IF  LEN(a$)  =  2  THEN 
'pgup,  pgdn  pressed 

CALL  wlocate  (localrow,  localcol) 

CALL  fprint(disease$(counter),  nl) 

code2key  =  ASC(RlGHT$(a$,  1)) 

SELECT  CASE  code2key 
CASE  72  'up  arrow 
counter  =  counter  -  1 

IF  counter  firstword  THEN  counter  =  lastword 

CASE  80  ’down  arrow 
counter  =  counter  +  1 

IF  counter  lastword  THEN  counter  =  firstword 

CASE  73  ’PgUp 

if  page  =  2  then 
page=l 
end  if 
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'PgDn 


CASE  81 
if  page  =  1  then 
page=2 
end  if 

CASE  ELSE 
BEEP 

END  SELECT 

if  (code2key  73)  and  (code2key  81)  then 
CALL  computerowcol(counter  -  firstword  +  1,  localrow,  localcol) 
CALL  wlocate  (localrow,  localcol) 

CALL  fprint(disease$(counter),  inverse) 
end  if 

ELSE 
’other  keys 

SELECT  CASE  ASC(LEFT$(a$,  1)) 

CASE  27  'Esc  to  exit 

CASE  13  ’CR  to  accept 

call  pridiseasedefs(counter)  'call  subroutine  to  display  definition 
CASE  ELSE 
BEEP 

END  SELECT 
END  IF 

REM  loop  until  Esc,  PgDn  or  PgUp 
LOOP  UNTIL  a$  =  CHR$(27)  or  (code2key=8 1 )  or  (code2key=73) 
code2key=0 
if  a$=chr$(27)  then 

CALL  removewindow  'containing  definition  list 
CALL  removewindow  ’  blank  window 
LOCATE , ,  0 
else 

call  clearwindow 
goto  printnewpage2 
end  if 
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END  SUB 


Subroutine  PRID1SEASEDEFS 
called  from:  DISEASEDEFINITIONS 

calls:  PUSHWINDOW,  WLOCATE,  FPRINT,  CLEARWINDOW,  RE  MOVE  WINDOW 

This  routine  creates  a  window  and  displays  the  selected  disease 

definition. 


SUB  pridiseasedefs(counter)  STATIC 


dim  startrec(40),  endrec(40) 
pagelimit=l  1 
field#3,  60  as  records 
numlines=disindx(counter,  2) 
if  numlines  pagelimit  then 
numofpages  =  int(numlines/pagelimit) 
linesonlastpage=numlines  mod  pagelimit 
if  linesonlastpage  Othen 
numofpages=numofpages+ 1 
end  if 

linesonpage=pagelimit 

else 

numofpages=l 
linesonlastpage=0 
linesonpage=numlines 
end  if 

firstrec=disindx(counter,  1) 
lastrec=disindx(counter,  l)+disinrtx(counter,  2)-l 
page=l 

startrec(page)=firstrec 

endrec(page)=startrec(page)+linesonpage-l 

page=page+l 

do  while  page  numofpages 
startrec(page)=endrec(page- 1 )+ 1 
endrec(page)=startrec(page)+linesonpage-l 
page=page+l 
loop 

if  linesonlastpage  0  then 
startrec(page)=endrec(page- 1 )+ 1 
endrec(page)=startrec(page)+linesonlastpage-l 
else 

startrec(page)=endrec(page- 1 )+ 1 
endrec(page)=startrec(page)+linesonpage-l 
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end  if 

CALL  pushwindow(def2s,  def2f, 6, 7,  linesonpage+3, 66) 
locate  linesonpage+8, 15 

call  fprint  ("PgUp  -  Previous  Page  PgDn  -  Next  Page  Esc  -  Quit", 
abs(de£2f)) 

color  normal,  bground 
page=  1 
do 

l=l:c=4 

for  r=startrec(page)  to  endrec(page) 
get#3,  r 

call  wlocate(l,  c) 

call  fprint  (records  ,  def2s) 

1=1+1 
next  r 

call  wlocate  (linesonpage+1, 48) 
whatpage$="Page"+str$(page)+"  of'+str$(numofpages) 
call  fprint  (whatpage$,  def2s) 
do 

z2$=inkey$ 
loop  while  z2$="" 
select  case  asc(right$(z2$,  1)) 
case  81  ’PgDn 

page=page+l 
case  73  ’PgUp 

page=page-l 
if  page  1  then 
page  =  1 
end  if 
case  else 

if  asc(z2$)  27  then 
beep 
end  if 
end  select 

CALL  clearwindow 

loop  until  (page  numofpages)  or  (asc(z2$)=27) 
call  removewindow 
for  page=  1  to  numofpages 
startrec(page)=0 
endrec(page)=0 
next  page 
numlines  =  0 

END  SUB 
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Appendix  E 

User  Library  File  Listings 


> 

DENTSUBS.BAS 


REM  All  the  subroutines  for  DENTAL  and  DIFF,  except  for  the  window  and 
definition  routines,  are  contained  in  this  module. 

REM  This  module  was  last  modified  on  1/30/89  by  Cindy  Burgess-Russotti 
DEFINT  A-Z 

REM  Dimension  arrays  for  DENTAL  and  DIFF  programs. 

DIM  Z(35) 

DIM  DX$(35) 

DIM  response(92) 

dim  option$(10,2),  opline(lO) 

dim  dgpos(35,2),treatnum(35,2),numdg(2),treatidx(35) 

dim  tdline(35),  corpresp(36) 


REM  Dimension  arrays  for  definition  routines. 

DIM  item$(120),dindx(120,2),disease$(33),disindx(33,2) 

REM  include  common  statements  for  all  modules 
rem  $include:  ’dentcomm.bas’ 

Subroutine  PRIQUES 

called  from:  main  program  (DENTAL)  and  DIFF. 

This  routine  prints  a  question  on  the  screen. 

sub  priques(q$)  static 

REM  print  question 

charlimit=70 

color  quescolor,bground 

stan: 

if  len(q$)  charlimit  then  'Break  up  the  question  if  it  is  longer  than 
the  limit  (charlimit). 


1 
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b=charlimit 

while  asc(mid$(q$,b»l))  32 
b=b-l 
wend 

temp$=left$(q$,b) 
q$=right$(q$,len(q$)-b) 
locate  qrow,qcol 
print  temp$; 
qrow=qrow+l 
goto  start 
else 

locate  qrow.qcol 
print  q$; 
end  if 

color  normal,bground 
end  sub 

subroutine  PRIOPTIONS 
called  from:  DENTAL  and  DIFF 

This  routine  displays  the  responses  to  each  question  and  it  displays  the 
pointer  in  front  of  the  first  response. 

sub  prioptions  static 

oprow=qrow+3:opcol=int((80-longest)/2)+5  ’  odd  2  for  ptr ,2  for  ast  1  blnk 

ptrcol=opcol-5 

for  x=l  to  numops 
if  x=l  then 

color  ptrcolor.bground 
locate  oprow,ptrcol:print  ptr$ 
color  normal.bground 
end  if 

locate  oprow,opcol 
opline(x)=oprow 
print  option$(x,l); 
oprow=oprow+2 
if  option$(x,2)""  then 
locate  oprow-l,opcol 
print  option$(x,2); 
oprow=oprow+l 
end  if 
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next  x 
end  sub 


Subroutine  GETRESP 

Called  from:  DENTAL  and  DIFF 

calls:  PRINTOP 

This  routine  waits  for  a  response  from  the  user.  To  respond,  the  user 
can  press  a  number  that  corresponds  to  a  response  or  he  can  use  the 
direction  keys  to  move  the  pointer  to  the  desired  response  then  press 
return  to  select  that  response.  This  routine  also  allows  the  user  to 
press  F7  for  the  main  menu  and  F10  for  a  submenu. 

sub  getresp  static 
astcol=opcol-2 
count=l 
ans=0 

while  ans=0 

DO  UNTIL  z$=""  ’  clear  keyboard  buffer 

z$=inkey$ 

LOOP 

DO  ’  now  get  response 

z$=inkey$ 

LOOP  WHILE  z$=”" 

if  val(z$)  =  1  and  val(z$)  numops  then  entered  valid  number 

REM  print  blanks  where  old  ptr  is 

locate  opline(count),ptrcol:print  blanks2$; 

count=val(z$) 

color  ptrcolor,bground 

locate  opline(count),ptrcol:print  ptr$; 

color  resplettr.respbar 

call  printop(count) 

color  normal.bground 

pause !  =TIMER+ 1 

do  while  TIMER  pause! 

loop 

ans=val(z$) 

elseif  z$=chr$(13)  then 
color  resplettr,respbar 
call  printop(count) 
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color  normal  .bground 
ans=count 

elseif  len(z$)=2  then 
z$=right$(z$,l) 
if  z$=chr$(72)  then  ’***  up 

REM  print  blanks  where  old  ptr  is 

locate  opline(count),ptrcol:print  blanks2$; 
count=count- 1  :if  count  then  count=  1 
color  ptrcolor,bground 
locate  opline(count),ptrcol:print  ptr$; 
color  normal, bground 
elseif  z$=chr$(80)  then  ’***  down 

REM  print  blanks  where  old  ptr  is 

locate  opline(count),ptrcol:print  blanks2$; 
count=count+l:if  count  numops  then  count=numops 
color  ptrcolor,  bground 
locate  opline(count),ptrcol:print  ptr$; 
color  normal, bground 

elseif  z$=chr$(65)  then  ’***  F7 definitions 

call  definitionroutine2 

elseif  z$=chr$(67)  and  mmenu  0  and  wherefrom$="dental"  then  '***  F9 
main  menu 
ans=67 

elseif  z$=chr$(67)  and  wherefrom$="diff'  then  ’***  F9  main  menu 
ans=67 

elseif  z$=chr$(68)  and  mmenu  0  and  wherefrom$="dental"  then  '***  F10 
sub  menu 

if  mmenu=l  then 
ans=681 

elseif  mmenu=2  then 
ans=682 
end  if 

elseif  z$=chr$(68)  and  softmenu  0  and  wherefrom$="difr  then  ’***  F10 
sub  menu 
ans=68 
end  if 
end  if 
wend 
end  sub 
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Subroutine  PR1NTOP 
called  from:  GETRESP 

This  routine  is  called  after  the  user  selects  a  response.  The  response 
is  displayed  in  inverse  colors.  The  colors  are  set  in  getresp. 

sub  printop(count)  static 

locate  opline(count),opcol 
print  option$(count,l);" 

if  option$(count,2)""  then 
locate  opline(count)+l,opcol 
print  option$(count,2); 

if  len(option$(count,l))  len(option$(count,2))  then 
print  space$(len(option$(count,  1  ))-len(option$(count,2))+ 1 ); 
else 
print " 
end  if 
end  if 
end  sub 

Subroutine  INITOPTIONS 
called  from:  DENTAL  and  DIFF. 

This  routine  resets  the  elements  of  the  option  array  to  null  strings. 

sub  initoptions  static 
erase  options 
end  sub 

Subroutine  BOX 

called  from:  DENTAL  and  DIFF 

This  routine  draws  a  box  around  the  screen. 

SUB  BOX  (begrow,begcol,endrow,endcol)  STATIC 
URCNR$=CHR$(  1 87) 

ULCNR$=CHR$(201 ) 

SIDE$=CHR$(  1 86) 

LRCNR$=CHR$(  1 88) 

LLCNR$=CHR$(200) 

TOP=205 :  BOT =205 

LOCATE  BEGROW,BEGCOL:PRINT  ULCNRS; 
STRING$(endcol-begcol- 1  ,TOP);URCNR$; 

X  =  endrow-begrow- 1 
WHILE  X  0 


DENTAL  Programmer’ s  Manual  E-33 


LOCATE  BEGROW+X,BEGCOL:PRINT  SIDE$;:LOCATE  BEGROW+X,  end  COL: 
PRINT  SIDES; 

X=X  1 
WEND 

LOCATE  endrow,BEGCOL:PRINT  LLCNR$;STRING$(endcol-begcol-l,BOT);LRCNR$; 
END  SUB 

subroutine  WRTDAT 

called  from:  DENTAL  and  DEFF 

This  routine  writes  the  responses  to  all  the  questions  in  DENTAL  and  DIFF 
to  a  file  (DENTAL.DAT).  If  the  file  does  not  exist,  it  is  created. 

’  subroutine  to  write  data  to  file 
’  file  name  is  dental.dat 

’  needs  ssn,age  and  z  array  from  main 

SUB  wrtuat  static 

open  "dental.dat"  for  random  as  #2  len=374 

field  #2, 9  as  ss$,  2  as  ag$,  10  as  dt$,  5  as  tm$,  92  as  r$,_ 

2  as  npb$,  2  as  nps$,  70  as  pb$,  70  as  ps$,  72  as  cpdx$,_ 

40  as  othr$ 

'find  out  last  rec  num  in  file 
fsize=lof(2) 
recnum=fsize/374 
recnum=recnum+l 

’init 

nprob=0:nposs=0 
prob$="":  poss$="” 
corpdx$="" 

’  t reute  p  tub's  and  poss$  from  z  array 
for  x=l  to  35 
if  z(x)=l  then 
nprob=nprob+ 1 
prob$=prob$+right$(str$(x),2) 
elseif  z(x)=2  then 
nposs=nposs+ 1 

poss$=poss$+right$(str$(x),2) 
end  if 
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next  x 


for  x=l  to  36 
if  corpresp(x)=l  then 
corpdx$=corpdx$+right$(str$(x),2) 
end  if 
next  x 

’make  response  array  into  a  string 
for  x=l  to  92  '92  responses  dental +diff 

rcsponse$=rcsponse$+right$(str$(response(x)),  1 ) 
next  x 

’  load  buffer  and  print 
lset  ss$=ssn$ 
lset  ag$=age$ 
lset  dt$=date$ 
lset  tm$=left$(time$,5) 
lset  r$=response$ 
lset  npb$=mki$(nprob) 
lset  nps$=mki$(nposs) 
lset  pb$=prob$ 
lset  ps$=poss$ 
lset  cpdx$=corpdx$ 
lset  othr$=other$ 

put  #2,  recnum 
close  #2 
END  SUB 

Subroutine  GETSSN 
called  from:  DENTAL 

In  this  routine  the  user  is  asked  to  enter  the  patient’s  social  security 
number  and  age. 

SUB  getssn  static 

ssn$="" 

age$="" 

color  ssnbox.bground 
lc=21  :llen=38:rc=llen+lc- 1 
row=10:locate  row,lc:print  string$(llen,176) 
for  row  =  1 1  to  1 5 

locate  row,lc:print  chr$(176);:print  string$(llen,30);:locate  row,rc:print 
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chr$(176); 
next  row 

row=16:locate  row,lc:print  string$(llen,176); 
color  quescolor.bground 

locate  12,24:print"Enter  patient’s  SSN: _ - _ - _ 

color  normal,bground 
ssncol=45 

DO 

locate  12,ssncol,l,5,6 
DO 

s$=inkey$ 

LOOP  while  s$="" 
if  asc(s$)=8  then 
ssncol=ssncol-l 
if  ssncol-  then 
ssncol=45 

elseif  len(ssn$)=3  or  len(ssn$)=5  then 
ssncol=ssncol-l 
end  if 

locate  12, ssncol 
color  quescolor.bground 
print  _  ; 

color  normal.bground 
if  len(ssn$)0  then 
ssn$=right$(ssn$,len(ssn$)- 1 ) 
end  if 

elseif  asc(s$)47  and  asc(s$);  and  len(ssn$)  then 
print  s$; 
ssn$=ssn$+s$ 
if  len(ssn$)=9  then 
locate  ,„6,7 
end  if 

ssncol=ssncol+l 

if  len(ssn$)=3  or  len(ssn$)=5  then 
ssncol=ssncol+l 
end  if 

elseif  asc(s$)=13  then 
if  len(ssn$)  then 

beep 
end  if 
else 
beep 
end  if 
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LOOP  until  len(ssn$)=9  and  asc(s$)=13 

’  get  patient  age 

color  quescolor.bground 

locate  14,24:print"Enter  patient’s  AGE: _ " 

color  normal.bground 

agecol=45 

s$="" 

DO 

locate  14,agecol,l,5,6 
DO 

s$=inkey$ 

LOOP  while  s$="" 
if  asc(s$)=8  then 
agecol=agecol-l 
if  agecol-  then 
agecol=45 
end  if 

locate  14,agecol 

color  quescolor.bground 

print 

color  normal, bground 
if  len(age$)0  then 
age$=right$(age$,len(age$)- 1 ) 
end  if 

elseif  asc(s$)47  and  asc(s$);  and  len(age$)  then 
print  s$; 
age$=age$+s$ 
if  len(age$)=2  then 
locate  ,„6,7 
end  if 

agecol=agecol+l 
elseif  asc(s$)=13  then 
if  len(age$) then 
beep 
end  if 
else 
beep 
end  if 

LOOP  until  len(age$)=2  and  asc(s$)=13 
’turn  cursor  off 
locate  „0 

color  normal.bground 
END  SUB 
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Appendix  F 
Program  Flowchart 


FLOWCHART 

The  following  flowchart  depicts  the  decision-making  process  of  the  original  program  practiced  by 
the  Naval  Dental  Research  Institute,  Great  Lakes,  IL.  It  does  not  include  any  changes  made  to  the 
user  interface  by  the  Naval  Submarine  Medical  Research  Laboratory,  Groton,  CT.  The  numbers  in 
the  diagram  which  follow  do  not  refer  to  the  present  program. 


Diagnosis  or  Dental  Emergencies 
11  Discomfort  or  rain,  not  trauma  related 
2)  Discomfort  or  rain,  trauma  related 


Display  Text 


Display  Question,  number  in  upper 

RIGHT  CORNER  (X)  IS  THE  NUMBER  OF 

responses  for  that  question. 


Decision  /  Branch 


Execute  Subroutine 


Branch  to  Line  Number 


CD 


Start,  End,  Subroutine 
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